form033.frm

锥齿轮CAD设计

VERSION 5.00
Begin VB.Form Form033点花线比例及标注位置 
   Caption         =   "杂集"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form19"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "Form033点花线比例及标注位置"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 


Sub Example_TextPosition()               '如何更改尺寸标注位置?
    Dim dimObj As AcadDimAligned
    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    Dim location(0 To 2) As Double
    
    '定义标注
    point1(0) = 5#: point1(1) = 3#: point1(2) = 0#
    point2(0) = 10#: point2(1) = 3#: point2(2) = 0#
    location(0) = 7.5: location(1) = 5#: location(2) = 0#
    
    Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
    
    '下面的三个属性设置文字的排列格式
    dimObj.TextInside = False
    dimObj.TextOutsideAlign = False
    dimObj.TextMovement = acMoveTextAddLeader
    
    ZoomExtents
    Debug.Print "The current text position for the dimension is " _
                & dimObj.TextPosition(0) & ", " _
                & dimObj.TextPosition(1) & ", " _
                & dimObj.TextPosition(2)
    
    '这里可以指定文字最后的位置
    location(0) = 15: location(1) = 10: location(2) = 0
    dimObj.TextPosition = location
    
    dimObj.Update
    ZoomExtents
    Dim retPoint As Variant
    retPoint = dimObj.TextPosition
    Debug.Print "The new text position for the dimension is " _
                & dimObj.TextPosition(0) & ", " _
                & dimObj.TextPosition(1) & ", " _
                & dimObj.TextPosition(2)

'以上程序代码大部分来自于AutoCAD的帮助系统。我觉得那里面很全面的，语法的知识很丰富，有时间多看看吧。










'使用AcadLine对象的LineTypeScale属性               ''''''''点画线
'可以参考以下代码段:

Dim ObjLine As AcadLine

Set ObjLine = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

ObjLine.Linetype = "CENTER"

ObjLine.LinetypeScale = 10

ThisDrawing.Application.Update

'若线仍然看不清楚，可再加大线型比例。





'我传个书上的例子:''''''''''''''如何画弧线


Sub Example_AddArc()

' This example creates an arc in model space.

Dim arcObj As AcadArc
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngleInDegree As Double
Dim endAngleInDegree As Double
' Define the circle
centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#
radius = 5#
startAngleInDegree = 10#
endAngleInDegree = 230#
' Convert the angles in degrees to angles in radians
Dim startAngleInRadian As Double
Dim endAngleInRadian As Double
startAngleInRadian = startAngleInDegree * 3.141592 / 180#
endAngleInRadian = endAngleInDegree * 3.141592 / 180#
' Create the arc object in model space
Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
ZoomAll

End Sub