Kshirsagar Posted November 7, 2008 Share Posted November 7, 2008 Hi, Does any one knows how to retrive 3D coordinate information of any object from AutoCAD VBA. Please watch following program in AutoCAD VBA:unsure: ---------------------------------------------------------------- Dim entity As AcadEntity,my3Dobj As Acad3DSolid For Each entity In ThisDrawing.ModelSpace MsgBox "entity.ObjectName = " & entity.ObjectName If LCase(entity.ObjectName) = "acdb3dsolid" Then MsgBox "found solid" Set my3Dobj = entity 'my3Dobj.( I don't understand which method will show XYZ 'coordinates of my3Dobj object. Please help me my3Dobj = Nothing End If Next ----------------------------------------------------------------- Quote Link to comment Share on other sites More sharing options...
SEANT Posted November 7, 2008 Share Posted November 7, 2008 As you may have already determined, VBA has limited access to the information stored within an Acad3dSolid. There are a few methods traditionally employed to deal with this situation but they generally require quite a bit of custom code. What exactly are you trying to find out about the Solid? Quote Link to comment Share on other sites More sharing options...
Kshirsagar Posted November 10, 2008 Author Share Posted November 10, 2008 Thanks SEANT for comment, Can you pass information about custom code which can retrive coordinates of 3D lines and save it in an array. I had search it in google but can not found any help. Quote Link to comment Share on other sites More sharing options...
SEANT Posted November 11, 2008 Share Posted November 11, 2008 Here’s a fairly basic routine to select some lines and store the endpoints into an array. The routine will print the endpoints to a Message Box. 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.