String Selection

[mcoffman]

I'm trying to figure out a small app to put together a schedule of blocks and their respective location within an architectural floorplan. I thought that I'd post here for suggestions while I work on it myself. The basic gist of what I want to be able to do is to create a loop where the user selects a block then selects the nearest room label. I then want to be able to extract the text string from the selected room label regardless of whether its DTEXT, MTEXT, or an attribute. I know LISP can select subentities but I'm unsure of how to go about it in VBA, especially if the selected label block has multiple attributes that I want to select in order (i.e. ROOMNAME and ROOMNUM).

I hope that makes sense! Any ideas and suggestions appreciated!

Thanks,
MC

[fixo]

Hi, MC
To select subentity, use this method (see Help):


Dim entObj As AcadObject '' >Or AcadEntity if you want
Dim varPt As Variant '' >This is a picked point
Dim tmx, ctx '' >there are matrix and another dark stuff
ThisDrawing.Utility.GetSubEntity entObj, varPt, tmx, ctx, "Select What You Want"



'Voila, you got this subentity

~'J'~

[mcoffman]

Thanks Fixo. That works great! My next question, is there an easy way to extract the textstring from an Entity? Currently I check to see if the entity is an attribute then I use a selection set SelectAtPoint to select the block at the point the SubEntity was selected, then use a GetAttributes and loop through all the attributes until the handle matches the SubEntity selection. Then I can get to the .textstring property. As you can see it's a rather bumbling way of going about it. It works but I'd like to find an easier way, especially one that can work with more than just attributes.

Thanks,
MC

[fixo]

Thanks Fixo. That works great! My next question, is there an easy way to extract the textstring from an Entity? Currently I check to see if the entity is an attribute then I use a selection set SelectAtPoint to select the block at the point the SubEntity was selected, then use a GetAttributes and loop through all the attributes until the handle matches the SubEntity selection. Then I can get to the .textstring property. As you can see it's a rather bumbling way of going about it. It works but I'd like to find an easier way, especially one that can work with more than just attributes.

Thanks,
MC
Hi again
Sorry I can't to understand your task correctly
but I think that in VBA you can use Collection object
this will gather all information you need (the same as LIST in Autolisp)
Hope this might help you with it, see example
Watch roomData in the watch window


Public Sub GetRoomData()

Dim fstEnt As AcadEntity
Dim varPt As Variant
Dim blkname As String
Dim oSsets As AcadSelectionSets
Dim oSset As AcadSelectionSet
Dim fType(0 To 1) As Integer
Dim fData(0 To 1) As Variant
Dim blkRef As AcadBlockReference
Dim attVar() As AcadAttributeReference
Dim oAttr As AcadAttributeReference
Dim roomData As New Collection
Dim tmpArr(1) As String
Dim i, j As Long

On Error GoTo Error_Trapp
ThisDrawing.Utility.GetEntity fstEnt, varPt, _
"Select block with room data"

If Not TypeOf fstEnt Is AcadBlockReference Then
MsgBox "This is not a block entry, try again"
Exit Sub
Else
blkname = fstEnt.Name

Set oSsets = ThisDrawing.SelectionSets

For Each oSset In oSsets
If oSset.Name = "BlkRefSet" Then
oSset.Delete
End If
Next

Set oSset = oSsets.Add("BlkRefSet")
fType(0) = 0: fData(0) = "INSERT"
fType(1) = 2: fData(1) = blkname

' select all block entries:
oSset.Select acSelectionSetAll, , , fType, fData

For Each blkRef In oSset
attVar = blkRef.GetAttributes
For i = 0 To UBound(attVar)
Set oAttr = attVar(i)
Select Case oAttr.TagString
Case "ROOMNAME"
tmpArr(0) = oAttr.TextString
Case "ROOMNUM"
tmpArr(1) = oAttr.TextString
' here is another case you need
''.........................''
End Select
Next i
roomData.Add tmpArr
Next blkRef

' Do with this collection what you need:
' For debug only:
For j = 1 To roomData.Count
MsgBox CStr(roomData.Item(j)(0)) & " " & CStr(roomData.Item(j)(1))
Next j

End If
oSset.Delete

Error_Trapp:
MsgBox Err.Description

End Sub

~'J'~

[mcoffman]

From the look of it your code is similar to what I'm already doing. The code below is the relevant excerpt from the function I've been working on.




ElseIf inputString = "PickDescription" Then
strDesc(intCount) = ""
intEntCount = 0
blnCycle = True
Do Until blnCycle = False
On Error Resume Next
ThisDrawing.Utility.GetSubEntity objEntity, varEntPt, tmx, ctx, vbCrLf & "Select description data: "
If Err Then
If StrComp(Err.Description, "Method 'GetSubEntity' of object 'IAcadUtility2' failed", 1) = 0 Then
intMsg = MsgBox("No information selected. Are you finished?", vbYesNo + vbInformation, "Nothing Selected")
If intMsg = vbNo Then
blnCycle = True
ElseIf intMsg = vbYes Then
blnCycle = False
End If
End If
End If
If LCase(objEntity.ObjectName) = "acdbattribute" Then
ssEnt.SelectAtPoint varEntPt
For Each objBlockRef In ssEnt
varAttributes = objBlockRef.GetAttributes
For ii = 0 To UBound(varAttributes)
If varAttributes(ii).Handle = objEntity.Handle Then
strAtt = varAttributes(ii).TextString
If Left(strAtt, 1) = " " Then
strAtt = Mid(strAtt, 2)
End If
strDesc(intCount) = strDesc(intCount) & " " & strAtt
ThisDrawing.Utility.Prompt vbCrLf & strDesc(intCount)
End If
Next ii
Next
End If
ssEnt.Clear
intEntCount = intEntCount + 1
Loop


My objective is to be able to extract the textstring from ANY selected object containing text, whether it be DText, MText, Block Attribute, Nested entity, etc. Currently my code is only capable of extracting information from block attributes that are not nested. I was hoping that I could just do something like strDesc = objEntity.TextString but I haven't figured out a way to make something so simple work.

MC

[Jeff_M]

MC,
Give this method a try:


Do Until blnCycle = False
ThisDrawing.Utility.GetSubEntity objEntity, varEntPt, tmx, ctx, vbCrLf & "Select description data: "
If Err Then
If StrComp(Err.Description, "Method 'GetSubEntity' of object 'IAcadUtility2' failed", 1) = 0 Then
intMsg = MsgBox("No information selected. Are you finished?", vbYesNo + vbInformation, "Nothing Selected")
If intMsg = vbNo Then
blnCycle = True
GoTo Resume_Here
ElseIf intMsg = vbYes Then
blnCycle = False
End If
End If
End If
Select Case LCase(objEntity.ObjectName)
Case Is = "acdbattribute"
strAtt = objEntity.TextString
'''if the above line fails, cast the object to an attribute
'Dim oAtt as AcadAttribute
'set oAtt = objEntity
'strAtt = oAtt.TextString
If Left(strAtt, 1) = " " Then
strAtt = Mid(strAtt, 2)
End If
Case Is = "acdbtext"
'do your text thing here
Case Is = "acdbmtext"
'do your mtext thing here
Case Else
'do nothing, or warn user that a Text object wasn't selected
End Select
Resume_Here:
Loop
End Sub

[mcoffman]

Miff, your idea is exactly what I was looking for! I took your idea and worked it into the code and it works exactly as I hoped it would. I appreciate your help greatly! I was not aware of the Select Case method, I'll have to tuck that one away for future reference!

Thanks!
MC

[fixo]

Thanks Miff, you saved my time also
:)

~'J'~