原文链接:
http://adndevblog.typepad.com/manufacturing/2016/03/get-sketch-dimension-points.html
每种类型的标注可能以不同对象提供标注点。本文仅就TwoLineAngleDimConstraint做一样例。先选择某标注后,获取点,创建工作点
Sub DeletePoints(c As ObjectCollection)
Dim o As Object
For Each o In c
o.Delete
Next
Call c.Clear
End Sub
Sub GetDimensionGeometry()
' The Sketch needs to be active and a
' two line angle dimension constraint needs
' to be selected in the UI
Dim d As TwoLineAngleDimConstraint
Set d = ThisApplication.ActiveDocument.SelectSet(1)
Dim sps As SketchPoints
Set sps = d.Parent.SketchPoints
Dim sp As SketchPoint
Dim c As ObjectCollection
Set c = ThisApplication.TransientObjects.CreateObjectCollection()
' Anchor points (A1..A5)
Dim pt As Point2d
For Each pt In d.AnchorPoints
Call c.Add(sps.Add(pt))
Next
MsgBox ("AnchorPoints")
Call DeletePoints(c)
' LineOne (L1S, L1E)
Call c.Add(sps.Add(d.LineOne.StartSketchPoint.Geometry))
Call c.Add(sps.Add(d.LineOne.EndSketchPoint.Geometry))
MsgBox ("LineOne")
Call DeletePoints(c)
' LineTwo (L2S, L2E)
Call c.Add(sps.Add(d.LineTwo.StartSketchPoint.Geometry))
Call c.Add(sps.Add(d.LineTwo.EndSketchPoint.Geometry))
MsgBox ("LineTwo")
Call DeletePoints(c)
' DimensionCenterPoint (DC)
Call c.Add(sps.Add(d.DimensionCenterPoint))
MsgBox ("DimensionCenterPoint")
Call DeletePoints(c)
' TextPoint (TP)
Call c.Add(sps.Add(d.TextPoint))
MsgBox ("TextPoint")
Call DeletePoints(c)
End Sub