Select only Block Reference and Text

Hi All,

I have created a selection set in which i want only Text and Block Reference to be included to retreive information out of it. I've been using the following code for the same

For Each SOS In ThisDrawing.SelectionSets
    If SOS.name = "MySS" Then
       ThisDrawing.SelectionSets("MySS").Delete
    Exit For
    End If
 Next
 
 intCode(0) = 0: varData(0) = "BLOCK REFERENCE,TEXT"
 ThisDrawing.SelectionSets.add ("MySS")
 Set objSS = ThisDrawing.SelectionSets("MySS")
 objSS.SelectOnScreen intCode, varData
 
 If objSS.Count < 1 Then
    MsgBox "Nothing Selected!"
 Exit Sub
 End If



For Each objent In objSS
Select Case objent.ObjectName
   Case "AcDbBlockReference"
   Set block = objent
       x = block.insertionPoint(0)
       y = block.insertionPoint(1)
MsgBox "x: " & x & vbCrLf & "y: " & y

   Case "AcDbText"
   Set textobj = objent
   MsgBox textobj.textstring
   
End Select
Next

This would allow me to select Text but not block reference.

I want to know the exact name for block reference that i can use in:

intCode(0) = 0: varData(0) = "BLOCK REFERENCE,TEXT"

to select block reference and text only

Thanks and Regards,

Priyanka

intCode(0) = 0: varData(0) = "INSERT,TEXT"

Did you look into acSelectionSetCrossingPolygon for entities intersecting circles from this thread?

http://www.cadtutor.net/forum/showthread.php?t=34980

Hi Seant,

This "insert" keyword works the way I wanted it to be. Thanks!

I tried the circle code, but it was actually a little too complicated for my calibre of programming skills. Unfortunately, couldn't do much on it.Anyways, Thanks a lot!

Regards,

Priyanka

Hi Seant,

 

This "insert" keyword works the way I wanted it to be. Thanks!

 

I tried the circle code, but it was actually a little too complicated for my calibre of programming skills. Unfortunately, couldn't do much on it.Anyways, Thanks a lot!

 

Regards,

Priyanka

Thank you for your code,

pls could you help me to select more blocks with a certain block name (X1-O-180) in the drawing and get for each of them the coordinates ?

I tried the below code but with-out success, I thin that the issue is inside the selection !.

IntCOde(0) = "0": VarData(0) = "X1-O-180"

objSS.Select acSelectionSetAll, IntCOde, VarData

thks

See this modification to the code above.

Sub getzInsPt()

Dim intCode(1) As Integer
Dim varData(1) As Variant
Dim X As Double
Dim Y As Double
Dim Z As Double
Dim Block As AcadBlockReference
Dim SOS As AcadSelectionSet
Dim objent As AcadEntity
Dim strMsg As String


For Each SOS In ThisDrawing.SelectionSets
    If SOS.Name = "MySS" Then
       ThisDrawing.SelectionSets("MySS").Delete
    Exit For
    End If
 Next
 
 intCode(0) = 0: varData(0) = "INSERT"
 intCode(1) = 2: varData(1) = "X1-O-180"
 ThisDrawing.SelectionSets.Add ("MySS")
 Set SOS = ThisDrawing.SelectionSets("MySS")
 SOS.Select acSelectionSetAll, , , intCode, varData
 
 If SOS.Count < 1 Then
    MsgBox "Nothing Selected!"
 Exit Sub
 End If



  For Each objent In SOS

     Set Block = objent
       X = Block.InsertionPoint(0)
       Y = Block.InsertionPoint(1)
       Z = Block.InsertionPoint(2)
       strMsg = strMsg & "x: " & X & ", y: " & Y & ", z: " & Z & vbCrLf
  Next
  MsgBox strMsg

End Sub

See this modification to the code above.

 

Sub getzInsPt()

Dim intCode(1) As Integer
Dim varData(1) As Variant
Dim X As Double
Dim Y As Double
Dim Z As Double
Dim Block As AcadBlockReference
Dim SOS As AcadSelectionSet
Dim objent As AcadEntity
Dim strMsg As String


For Each SOS In ThisDrawing.SelectionSets
    If SOS.Name = "MySS" Then
       ThisDrawing.SelectionSets("MySS").Delete
    Exit For
    End If
 Next
 
 intCode(0) = 0: varData(0) = "INSERT"
 intCode(1) = 2: varData(1) = "X1-O-180"
 ThisDrawing.SelectionSets.Add ("MySS")
 Set SOS = ThisDrawing.SelectionSets("MySS")
 SOS.Select acSelectionSetAll, , , intCode, varData
 
 If SOS.Count < 1 Then
    MsgBox "Nothing Selected!"
 Exit Sub
 End If



  For Each objent In SOS

     Set Block = objent
       X = Block.InsertionPoint(0)
       Y = Block.InsertionPoint(1)
       Z = Block.InsertionPoint(2)
       strMsg = strMsg & "x: " & X & ", y: " & Y & ", z: " & Z & vbCrLf
  Next
  MsgBox strMsg

End Sub

Thank you very much ! now it's working.

I'll ask you some other detail later !......

The final scope will be to transfer in a new blocks placed on the drawing some attributes extracted from "X1-O-180" blocks, or attributes from it selfs, after a manipulation from text editor or excel.

It's an hard job ?

So I'll work on again.

Thank you for your patience.