请教高手,急啊
Public Sub HandleAndHAndleToObject()Dim entHandle As String
Dim entHandlekk As String
Dim entry As AcadEntity
Dim entrykk As AcadEntity
Dim tempobj As AcadObject
Dim tempobjkk As AcadObject
Dim det1 As String
Dim det2 As String
Dim Pnt1 As Variant
Dim Pnt2 As Variant
Dim a(0 To 2) As Double
Dim b(0 To 2) As Double
Dim c(0 To 2) As Double
Dim d(0 To 2) As Double
Dim e(0 To 2) As Double
Dim f(0 To 2) As Double
Dim av As Variant
Dim ai As Variant
Dim oldname As String
Dim newname As String
Dim Arcstartpoint As Variant
Dim Arcendpoint As Variant
Dim Circlecenter As Variant
Dim OkLine As AcadLine
For Each entry In ThisDrawing.ModelSpace
entHandle = entry.handle
Set tempobj = ThisDrawing.HandleToObject(entHandle)
If tempobj.ObjectName = "AcDbPolyline" Then '************多段线***********
tempobj.color = acGreen
av = tempobj.Coordinates
a(0) = av(0)
a(1) = av(1)
a(2) = av(2)
Pnt1 = a
det1 = axEnt2lspEnt(tempobj)
For Each entrykk In ThisDrawing.ModelSpace
entHandlekk = entrykk.handle
Set tempobjkk = ThisDrawing.HandleToObject(entHandlekk)
If tempobjkk.ObjectName = "AcDbCircle" Then '************被切圆***********
tempobjkk.color = acRed
oldname = tempobjkk.ObjectName
ai = tempobjkk.Center
b(0) = ai(0) + tempobjkk.Radius
b(1) = ai(1)
b(2) = ai(2)
Pnt2 = b
det2 = GetDoubleEntTable(tempobjkk, Pnt2)
ThisDrawing.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr
ThisDrawing.Regen ture
newname = tempobjkk.ObjectName
If oldname <> newname Then
MsgBox "被切圆的名称已经发生变化,由" & oldname & "变成" & newname _
+ vbCrLf & "但有些属性还不能用啊，如startpoint和endpoint" _
+ vbCrLf & "help help help help help help help help help help help help"
'Arcstartpoint = tempobjkk.StartPoint
'Arcendpoint = tempobjkk.EndPoint
'c(0) = Arcstartpoint(0)
'c(1) = Arcstartpoint(1)
'c(2) = Arcstartpoint(2)
'd(0) = Arcendpoint(0)
'd(1) = Arcendpoint(1)
'd(2) = Arcendpoint(2)
'Circlecenter = tempobjkk.Center
'e(0) = Circlecenter(0)
'e(1) = Circlecenter(1)
'e(2) = Circlecenter(2)
'f(0) = (c(0) + d(0)) / 2
'f(1) = (c(1) + d(1)) / 2
'f(2) = (c(2) + d(2)) / 2
'Set OkLine = ThisDrawing.ModelSpace.AddLine(e, f)
End If
End If
Next
End If
Next
ThisDrawing.Regen ture
End Sub
'转换双元表的函数
Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String
Dim entHandle As String
entHandle = entObj.handle
GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _
")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
End Function
'转换点的函数
Public Function axPoint2lspPoint(Pnt As Variant) As String
axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
End Function
'转换图元函数
Public Function axEnt2lspEnt(entObj As AcadEntity) As String
Dim entHandle As String
entHandle = entObj.handle
axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function 怎么什么都不说，描述一下问题。 这哪是请教？简直就是考我们来了！:lol
回复 3楼 的帖子
sorry,描述不清,是这样的,多段线是样板的外形,小圆是开口点,我想在开口点处向多段线外形上画一条小垂线标注开口,多段线和小圆是相交的,我想返回上述图元交点的坐标,两交点的中点和圆心画一直线即为所求垂线,但经过剪切后小圆已经变成了圆弧,却返不回这圆弧的两端点,而小圆实际上已经变成了圆弧(objectname属性已发生变化),搞不懂怎么回事.求救页:
[1]