AcadDimRotated的基本用法
本帖最后由 作者 于 2008-7-28 9:26:53 编辑在平常的画图中有时，标注的尺寸格式不统一，下面的程序能对AcadDimRotated的尺寸格式进行统一。
Function CreatSelectionSet(InputEntityObjectName As Variant) As AcadSelectionSet
On Error Resume Next
'Dim SSet As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("SelectEntity")) Then
Set CreatSelectionSet = ThisDrawing.SelectionSets.Item("SelectEntity")
CreatSelectionSet.Delete
End If
Set CreatSelectionSet = ThisDrawing.SelectionSets.Add("SelectEntity")
Pt1 = ThisDrawing.Utility.GetPoint(, "Input First Point")
Pt2 = ThisDrawing.Utility.GetCorner(Pt1, "Input First Point")
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 0
For ii = 0 To UBound(InputEntityObjectName)
dataValue(ii) = InputEntityObjectName(ii)
Next ii
CreatSelectionSet.Select acSelectionSetWindow, Pt1, Pt2, gpCode, dataValue
End Function
Sub ChangeDimensionData()
Dim SSet As AcadSelectionSet
Dim InputEntityObjectName As Variant
InputEntityObjectName = Array("Dimension")
Set SSet = CreatSelectionSet(InputEntityObjectName)
Dim Ent As AcadEntity
Dim objDimension As AcadDimension
Dim RotatedDimensionEntity As AcadDimRotated
'RotatedDimensionEntity.ExtensionLineColor=acByLayer
For Each objDimension In SSet
With objDimension
If .ObjectName = "AcDbRotatedDimension" _
Or .ObjectName = "AcDbRadialDimension" _
Or .ObjectName = "AcDbAlignedDimension" Then
.LinearScaleFactor = 2
End If
Debug.Print .ObjectName
.Layer = "尺寸线"
.TextHeight = 3.5
.DecimalSeparator = "."
.TextColor = acByLayer
.DimensionLineColor = acByLayer
If .ObjectName = "AcDbRotatedDimension" _
Or .ObjectName = "AcDbAlignedDimension" Then
.ExtensionLineColor = acByLayer
End If
.TextStyle = "WMF-宋体0"
End With
'Debug.Print Ent.ObjectName
Next objDimension
End Sub
页:
[1]