如何检索三维坐标i
你好有人知道如何从AutoCAD VBA中检索任何对象的三维坐标信息吗。
请在AutoCAD VBA中观看以下程序：不确定：
----------------------------------------------------------------
Dim实体作为AcadEntity，my3Dobj作为Acad3DSolid
对于此图形中的每个图元。模型空间
MsgBox“entity.ObjectName=”&实体。对象名称
如果LCase（entity.ObjectName）=“acdb3dsolid”，则
MsgBox“发现固体”
设置my3Dobj=实体
“my3Dobj。（我不知道哪种方法会显示my3Dobj对象的XYZ坐标。请帮助我
my3Dobj=无
如果结束
下一个
----------------------------------------------------------------- 正如您可能已经确定的那样，VBA对存储在Acad3dSolid中的信息的访问是有限的。传统上有几种方法用于处理这种情况，但它们通常需要相当多的自定义代码。
你到底想了解固体的什么？ 感谢肖特的评论，
您可以传递有关自定义代码的信息，该代码可以检索三维线的坐标并将其保存在数组中。我曾在谷歌上搜索过，但没有找到任何帮助。 这里有一个相当基本的例程，用于选择一些行并将端点存储到数组中。该例程将端点打印到消息框中。
Option Explicit
Sub Lines2Points()
Dim intCode(0) As Integer
Dim varData(0) As Variant
Dim entLine As AcadLine
Dim intLineQuantity As Integer
Dim arrLineCoords() As Variant
Dim i As Integer
Dim strMsg As String
intCode(0) = 0
varData(0) = "LINE"
intLineQuantity = (SoSSS(intCode, varData) * 2) - 1
If intLineQuantity > -1 Then
ReDim arrLineCoords(intLineQuantity)
For Each entLine In ThisDrawing.SelectionSets.Item("TempSSet")
arrLineCoords(i) = entLine.StartPoint
arrLineCoords(i + 1) = entLine.EndPoint
i = i + 2
Next
For i = 0 To intLineQuantity Step 2
strMsg = strMsg & "Start: " & PointToString(arrLineCoords(i)) _
& "--End: " & PointToString(arrLineCoords(i + 1)) & vbCr
Next
MsgBox strMsg
End If
End Sub
Function SoSSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
Dim objSSs As AcadSelectionSets
Dim objTempSS As AcadSelectionSet
Set objSSs = ThisDrawing.SelectionSets
For Each objTempSS In objSSs
If objTempSS.Name = "TempSSet" Then
objTempSS.Delete
Exit For
End If
Next
Set objTempSS = ThisDrawing.SelectionSets.Add("TempSSet")
'pick selection set
If IsMissing(grpCode) Then
objTempSS.SelectOnScreen
Else
objTempSS.SelectOnScreen grpCode, dataVal
End If
SoSSS = objTempSS.Count
End Function
Public Function PointToString(varPt As Variant) As String
Dim retVal As String, i As Long
For i = LBound(varPt) To UBound(varPt)
varPt(i) = Round(varPt(i), 2)
retVal = retVal & CStr(varPt(i)) & ","
Next
PointToString = Left(retVal, Len(retVal) - 1)
End Function
页:
[1]