[例程]使用尺寸--标注样式

mccad

Public Sub UseDimStyle()

    Dim curDimStyle As AcadDimStyle
    Dim newDimStyle As AcadDimStyle
   
    '保存当前尺寸样式的设置
    Set curDimStyle = ThisDrawing.ActiveDimStyle
    '将第三个尺寸样式设为当前尺寸样式
    Set newDimStyle = ThisDrawing.DimStyles _
                      ("NewStyle3 created by active document")
    ThisDrawing.ActiveDimStyle = newDimStyle
   
    '下面的代码将使用三个已创建好的尺寸样式的设置
    Dim dimObj1 As AcadDimAligned
    Dim dimObj2 As AcadDimAligned
    Dim dimObj3 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) = 10#: point1(1) = 125#: point1(2) = 0#
    point2(0) = 110#: point2(1) = 125#: point2(2) = 0#
    location(0) = 10#: location(1) = 180#: location(2) = 0#
    Set dimObj1 = ThisDrawing.ModelSpace.AddDimAligned _
                  (point1, point2, location)
   
    '创建第二个对齐尺寸标注
    point1(0) = 150#: point1(1) = 125#: point1(2) = 0#
    point2(0) = 250#: point2(1) = 125#: point2(2) = 0#
    location(0) = 150#: location(1) = 180#: location(2) = 0#
    Set dimObj2 = ThisDrawing.ModelSpace.AddDimAligned _
                  (point1, point2, location)
   
    '创建第三个对齐尺寸标注
    point1(0) = 290#: point1(1) = 125#: point1(2) = 0#
    point2(0) = 390#: point2(1) = 125#: point2(2) = 0#
    location(0) = 190#: location(1) = 180#: location(2) = 0#
    Set dimObj3 = ThisDrawing.ModelSpace.AddDimAligned _
                  (point1, point2, location)

    ZoomAll
'-----------------------------------
    '第一个尺寸标注使用第一个尺寸样式
    dimObj1.StyleName = "NewStyle1 created by dimension"
    '第二个尺寸标注使用第二个尺寸样式
    dimObj2.StyleName = "NewStyle2 created by Newstyle1"
   
    '恢复原来的尺寸样式设置
    ThisDrawing.ActiveDimStyle = curDimStyle
   
End Sub

Public Sub CreateDimStyle()

    '创建对齐尺寸并对有关属性进行设置
    '创建该对齐尺寸时，确保模型空间无其它图元的存在
    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) = 125#: point1(1) = 125#: point1(2) = 0#
    point2(0) = 250#: point2(1) = 125#: point2(2) = 0#
    location(0) = 125#: location(1) = 180#: location(2) = 0#

    '在模型空间创建对齐尺寸标注对象
    Set dimObj = ThisDrawing.ModelSpace.AddDimAligned _
                 (point1, point2, location)

    '对齐尺寸对象的有关属性设置将用来创建第一个尺寸样式
    dimObj.ArrowheadSize = 5               '标注箭头尺寸
    dimObj.DecimalSeparator = "."          '小数点符号
    dimObj.DimensionLineColor = acRed      '标注线颜色
    dimObj.ExtensionLineColor = acGreen    '尺寸界线颜色
    dimObj.ExtensionLineExtend = 3.5       '尺寸界线延伸量
    dimObj.TextHeight = 7                  '标注文字高度
    dimObj.TextGap = 2.5                   '标注文字与标注线的间隙

'----------------------------------------------------------------
    '对系统变量的设置将对整个图形文档起作用,用来设置第二个尺寸样式
    ThisDrawing.SetVariable "DIMDSEP", "."  '十进制数分割符
    ThisDrawing.SetVariable "DIMASZ", 8     '箭头的尺寸
    ThisDrawing.SetVariable "DIMCLRD", 5    '标注线颜色为兰色
    ThisDrawing.SetVariable "DIMCLRE", 6    '尺寸界线颜色
    ThisDrawing.SetVariable "DIMEXE", 5     '尺寸界线延长量
    ThisDrawing.SetVariable "DIMGAP", 3.5   '文字与标注线的间距
    ThisDrawing.SetVariable "DIMTXT", 8     '文字的高度

'---------------------------------------------------
    '准备创建新的尺寸样式
    Dim newStyle1 As AcadDimStyle
    Dim newStyle2 As AcadDimStyle
    Dim newStyle3 As AcadDimStyle

    '第一个尺寸样式的设置来自于在模型空间中刚创建好的对齐尺寸对象的设置
    Set newStyle1 = ThisDrawing.DimStyles.Add _
                    ("NewStyle1 created by dimension")
    Call newStyle1.CopyFrom(ThisDrawing.ModelSpace(0))
    '第二个尺寸样式的设置来自于第一个尺寸样式的设置
    Set newStyle2 = ThisDrawing.DimStyles.Add _
                    ("NewStyle2 created by Newstyle1")
    Call newStyle2.CopyFrom(ThisDrawing.DimStyles.Item _
                    ("NewStyle1 created by dimension"))
    '第三个尺寸样式的设置来自于图形文档的有关设置
    Set newStyle3 = ThisDrawing.DimStyles.Add _
                    ("NewStyle3 created by active document")
    Call newStyle3.CopyFrom(ThisDrawing)

    '删除已不用的对齐尺寸对象
    dimObj.Delete
   
End Sub

兰州人

好好研究MCCAD的好东东

鱼鱼么

多谢多谢 刚好有问题 看了这个贴 解决了 开心开心