BUrBaKy Posted June 1, 2010 Share Posted June 1, 2010 Hi there. I wrote this small code: Dim entObj As AcadEntity Dim ssetObj As AcadSelectionSet Dim grpCode(1) As Integer Dim dataVal(1) As Variant Dim x, y, z As Double grpCode(0) = 0 dataVal(0) = "MTEXT,TEXT" 'the type of the objects grpCode(1) = 8 dataVal(1) = "COTE,SECTIUNI" 'the names of the layers On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Add(SetName) If Err.Number <> 0 Then Set ssetObj = ThisDrawing.SelectionSets.Item(SetName) End If ssetObj.Clear Set ssetObj = ThisDrawing.SelectionSets.Add("SS01") ssetObj.SelectOnScreen grpCode, dataVal For i = 0 To ssetObj.Count - 1 x = ssetObj.Item(i).InsertionPoint(0) y = ssetObj.Item(i).InsertionPoint(1) z = ssetObj.Item(i).InsertionPoint(2) Next i The problem is that this x = ssetObj.Item(i).InsertionPoint(0) y = ssetObj.Item(i).InsertionPoint(1) z = ssetObj.Item(i).InsertionPoint(2) doesn't work. If i create a watch, i can see for each ssetObj.Item a value called InsertionPoint representing the insertion point value for x, y and z axis. Is there a way for me to get the insertion point values for each ssetObj.Item ? I thought of using group codes for this also. The group code for the insertion point as i found it is "40", but i don't know what command to use to get the value. Thanks in advance! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 1, 2010 Share Posted June 1, 2010 I'm more of a LISP guy but, should this On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Add(SetName) If Err.Number <> 0 Then Set ssetObj = ThisDrawing.SelectionSets.Item(SetName) End If Not be this: On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Add([color=Red][b]"SS01"[/b][/color]) If Err.Number <> 0 Then Set ssetObj = ThisDrawing.SelectionSets.Item([b][color=Red]"SS01"[/color][/b]) End If Quote Link to comment Share on other sites More sharing options...
Joro-- Posted June 1, 2010 Share Posted June 1, 2010 Hi, I think this should work Sub Test() On Error Resume Next Dim ssetObj As AcadSelectionSet Dim SetName As String SetName = "SS01" ThisDrawing.SelectionSets(SetName).Delete If Err Then Err.Clear Set ssetObj = ThisDrawing.SelectionSets.Add(SetName) Dim grpCode(1) As Integer Dim dataVal(1) As Variant grpCode(0) = 0 dataVal(0) = "MTEXT,TEXT" 'the type of the objects grpCode(1) = 8 dataVal(1) = "COTE,SECTIUNI" 'the names of the layers ssetObj.SelectOnScreen grpCode, dataVal For i = 0 To ssetObj.Count - 1 Dim var As Variant var = ssetObj.Item(i).InsertionPoint Debug.Print " x = " & var(0) Debug.Print " y = " & var(1) Debug.Print " z = " & var(2) Debug.Print Next i End Sub Regards, Joro Quote Link to comment Share on other sites More sharing options...
fixo Posted June 1, 2010 Share Posted June 1, 2010 Hi there.I wrote this small code: Dim entObj As AcadEntity Dim ssetObj As AcadSelectionSet Dim grpCode(1) As Integer Dim dataVal(1) As Variant Dim x, y, z As Double grpCode(0) = 0 dataVal(0) = "MTEXT,TEXT" 'the type of the objects grpCode(1) = 8 dataVal(1) = "COTE,SECTIUNI" 'the names of the layers On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Add(SetName) If Err.Number <> 0 Then Set ssetObj = ThisDrawing.SelectionSets.Item(SetName) End If ssetObj.Clear Set ssetObj = ThisDrawing.SelectionSets.Add("SS01") ssetObj.SelectOnScreen grpCode, dataVal For i = 0 To ssetObj.Count - 1 x = ssetObj.Item(i).InsertionPoint(0) y = ssetObj.Item(i).InsertionPoint(1) z = ssetObj.Item(i).InsertionPoint(2) Next i The problem is that this x = ssetObj.Item(i).InsertionPoint(0) y = ssetObj.Item(i).InsertionPoint(1) z = ssetObj.Item(i).InsertionPoint(2) doesn't work. If i create a watch, i can see for each ssetObj.Item a value called InsertionPoint representing the insertion point value for x, y and z axis. Is there a way for me to get the insertion point values for each ssetObj.Item ? I thought of using group codes for this also. The group code for the insertion point as i found it is "40", but i don't know what command to use to get the value. Thanks in advance! Looping trough selection you need to cast objects by its type separatelly both for text and mtext Try instead: Option Explicit Sub TestSelection() Dim entObj As AcadEntity Dim oText As AcadText Dim oMText As AcadMText Dim ssetObj As AcadSelectionSet Dim grpCode(1) As Integer Dim dataVal(1) As Variant Dim SetName As String Dim x As Double, y As Double, z As Double '<-- take a look at this line grpCode(0) = 0 dataVal(0) = "MTEXT,TEXT" 'the type of the objects grpCode(1) = 8 dataVal(1) = "COTE,SECTIUNI" 'the names of the layers SetName = "SS01" On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Add(SetName) If Err.Number <> 0 Then Set ssetObj = ThisDrawing.SelectionSets.Item(SetName) End If ssetObj.Clear Set ssetObj = ThisDrawing.SelectionSets.Add(SetName) ssetObj.SelectOnScreen grpCode, dataVal Debug.Print "Selected: " & ssetObj.Count & " objects" For Each entObj In ssetObj If TypeOf entObj Is AcadText Then Set oText = entObj x = oText.InsertionPoint(0) y = oText.InsertionPoint(1) z = oText.InsertionPoint(2) Debug.Print "Text object = > X= " & Round(x, 3) & ";Y= " & Round(y, 3) & ";Z= " & Round(z, 3) ElseIf TypeOf entObj Is AcadMText Then Set oMText = entObj x = CDbl(oMText.InsertionPoint(0)) y = CDbl(oMText.InsertionPoint(1)) z = CDbl(oMText.InsertionPoint(2)) Debug.Print "MText object = > X= " & Round(x, 3) & ";Y= " & Round(y, 3) & ";Z= " & Round(z, 3) End If Next End Sub ~'J'~ Quote Link to comment Share on other sites More sharing options...
BUrBaKy Posted June 2, 2010 Author Share Posted June 2, 2010 Thanks for your quick responses. I tried to apply your codes but they didn't work for me. However, i digged a little more and found something that worked, and it's a sort of a combination of your replyes. Dim x As Double, y As Double, z As Double '<-- take a look at this line For Each entObj In ssetObj var = entObj.InsertionPoint x = var(0) y = var(1) z = var(2) Next So, thanks again, i couldn't have done it without your help. Quote Link to comment Share on other sites More sharing options...
fixo Posted June 2, 2010 Share Posted June 2, 2010 Thanks for your quick responses.I tried to apply your codes but they didn't work for me. However, i digged a little more and found something that worked, and it's a sort of a combination of your replyes. Dim x As Double, y As Double, z As Double '<-- take a look at this line For Each entObj In ssetObj var = entObj.InsertionPoint x = var(0) y = var(1) z = var(2) Next So, thanks again, i couldn't have done it without your help. No problem Cheers ~'J'~ 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.