|
发表于 2004-10-15 18:41:00
|
显示全部楼层
我写的代码如下: Dim objMLine As AcadMLine, pnt
ThisDrawing.Utility.GetEntity objMLine, pnt, "请选择插入点:"
If Not objMLine.ObjectName = "AcDbMline" Then
ThisDrawing.Utility.Prompt "请选择插入点"
Exit Sub
End If
Dim tmpCircle As AcadCircle
Set tmpCircle = ThisDrawing.ModelSpace.AddCircle(pnt, 0.5)
Dim tmpPoint As Variant
tmpPoint = objMLine.IntersectWith(tmpCircle, acExtendBoth)
Dim pnt1(0 To 2) As Double
pnt1(0) = tmpPoint(3)
pnt1(1) = tmpPoint(4)
pnt1(2) = tmpPoint(5)
Dim pnt2(0 To 2) As Double
pnt2(0) = tmpPoint(0)
pnt2(1) = tmpPoint(1)
pnt2(2) = tmpPoint(2)
Dim tmpLine As AcadLine
Set tmpLine = ThisDrawing.ModelSpace.AddLine(pnt2, pnt1)
|
|