[code]
Sub test()
Dim objselectionset As AcadSelectionSet
Set objselectionset = ThisDrawing.SelectionSets.Add("objselectionset")
Dim entobj(0) As AcadEntity
Set entobj(0) = ThisDrawing.ModelSpace(0)
objselectionset.AddItems entobj
Set entobj(0) = ThisDrawing.ModelSpace(1)
objselectionset.AddItems entobj
Dim objselectionset1 As AcadSelectionSet
Set objselectionset1 = ThisDrawing.SelectionSets.Add("objselectionset1")
Set entobj(0) = ThisDrawing.ModelSpace(2)
objselectionset1.AddItems entobj
Set entobj(0) = ThisDrawing.ModelSpace(3)
objselectionset1.AddItems entobj
Dim entobj1 As AcadEntity
Dim entobj2 As AcadEntity
Dim pt As Variant
Dim lineobj As AcadLine
' 处理水平的直线
For Each entobj1 In objselectionset
For Each entobj2 In objselectionset1
Set lineobj = entobj1
pt = entobj1.IntersectWith(entobj2, acExtendNone)
If Sqr((pt(0) - lineobj.StartPoint(0)) ^ 2 + (pt(1) - lineobj.StartPoint(1)) ^ 2) _
用这样的ThisDrawing.ActiveTextStyle.fontFile = _
" C:/Program Files/ACAD2000/Fonts/italic.shx"改吗？
还是用别的方法
置顶卡
