VBA - working with group codes - need some help

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!

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

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

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'~

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.

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'~