兰州人 发表于 2009-8-12 12:13:00

选择集法修改尺寸线的标注比例和图层.

<p>主程序</p><p>Sub DimensionScale()<br/>&nbsp; Dim sSet As AcadSelectionSet<br/>&nbsp; Dim tempStr As String, fType, fData<br/>&nbsp; <br/>&nbsp; Set sSet = returnCornerAllSelects()<br/>&nbsp; Dim objDim As AcadDimension, objD As AcadDimRotated<br/>&nbsp; Dim Ent As AcadEntity<br/>&nbsp; For Each Ent In sSet<br/>&nbsp;&nbsp;&nbsp; If InStr(UCase(Ent.ObjectName), "DIMENSION") &gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objDim = Ent<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; With objDim<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .LinearScaleFactor = 10&nbsp; '尺寸标注比例<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Layer = "尺寸线"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End With<br/>&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp; Next Ent<br/>End Sub</p><p>选择集程序</p><p>Function returnCornerAllSelects() As AcadSelectionSet<br/>&nbsp; Dim sSet As AcadSelectionSet</p><p>&nbsp; Dim Pt1 As Variant, Pt2 As Variant<br/>&nbsp; With ConnectCad.ActiveDocument<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; Pt1 = .Utility.GetPoint(, "Select First Point")<br/>&nbsp;&nbsp;&nbsp; Pt2 = .Utility.GetCorner(Pt1, "Select Corner Point")<br/>&nbsp;&nbsp;&nbsp; Set sSet = .SelectionSets.Item(tempsSet)<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; sSet.Delete<br/>&nbsp;&nbsp;&nbsp; tempsSet = "temp"<br/>&nbsp;&nbsp;&nbsp; Set sSet = .SelectionSets.Add(tempsSet)<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; sSet.Select acSelectionSetCrossing, Pt1, Pt2<br/>&nbsp; End With<br/>&nbsp; Set returnCornerAllSelects = sSet<br/>End Function</p>

zzyong00 发表于 2009-8-14 09:54:00

版主是在放代码啊
页: [1]
查看完整版本: 选择集法修改尺寸线的标注比例和图层.