vbdPowerSet 1

[msstrang]

i'm running the following VBA application that is supposed to take the text from an autocad drawing and copy it to an excel spreadsheet, but when i try to debug it highlights "vbdPowerSet" and says:
compile "error: sub or function not defined"

i have a feeling i'm not referencing the vbdpowerset correctly, but can't find it in my reference when i check.
what should i do?


Public Sub GetText()
Dim objSelSet As AcadSelectionSet
Dim objEnt As AcadText
Dim intType(1) As Integer
Dim varData(1) As Variant
Dim intRow As Integer
Dim varAtts As Variant
Dim MyVar As Range
Dim DB As Workbook
Dim CP As Worksheet


Set DB = Application.ActiveWorkbook
Set CP = DB.ActiveSheet

On Error GoTo Err_Handler

Set objAcad = Nothing
Set objSelSet = vbdPowerSet("gettext")
intType(0) = 0
varData(0) = "TEXT,MTEXT"
objSelSet.Select acSelectionSetAll, _
filtertype:=intType, filterdata:=varData
intRow = 1

For Each objEnt In objSelSet
With objEnt
CP.Cells(intRow, 1).Value = objEnt.TextString
End With
intRow = intRow + 1
Next objEnt
ThisDrawing1.ActiveSpace = acPaperSpace
Exit_Here:
Exit Sub
Err_Handler:
MsgBox Err.Number & " " & Err.Description
End Sub

 

[TCARPENTER]

Hi msstrang,

You need the vbdPowerset utility, you can get it here:

http://www.tek-tips.com/faqs.cfm?fid=5792

HTH
Todd

 

[msstrang]

when i put this in a module with my other VBA code i get a new error with excel:
91 object Variable or With block variable not set

after debugging i found that the error occus in the vbdpowerset module at this line:
"Set objSelCol = ThisDrawing.SelectionSets"

any idea how to fix this?

 

[TCARPENTER]

Hi msstrang,

I don't know if the code you posted is complete, but I don't see where you are setting any kind of reference to the AutoCAD application, you have:

Set objAcad = Nothing

Since you are running this from Excel, you may want to set yourself up like this:

In the general portion of your code:

Public objAcad as AcadApplication
Public AcadDoc as AcadDocument

Then in your sub GetText:

Change this:

Set DB = Application.ActiveWorkbook
Set CP = DB.ActiveSheet

On Error GoTo Err_Handler

[red]Set objAcad = Nothing[/red]
Set objSelSet = vbdPowerSet("gettext")

To This:

Set DB = Application.ActiveWorkbook
Set CP = DB.ActiveSheet

On Error GoTo Err_Handler

[purple]Set objAcad = GetObject(,AutoCAD.Application)
Set AcadDoc = objAcad.Activedocument[/purple]

Set objSelSet = vbdPowerSet("gettext")

Then in vbdPowerset:

Change this:

Set objSelCol = ThisDrawing.SelectionSets

To this:

Set objSelCol = AcadDoc.SelectionSets

HTH
Todd

 

[msstrang]

i think you're right, but when i make these changes i get this excel error msg:
"compile error: Invalid Attribute in Sub or Function"

and the debugger highlights the "Public" before "objAcad As AcadApplication"

i tried putting these two public declarations outside of the GetText Sub () and got an error:

"438 Object doesn't support this property or method"

 

[TCARPENTER]

Hi msstrang,

Is your GetText sub in a module or a sheet, and when you moved the Public objAcad As AcadApplication, did you place it in the general area of your module/sheet? If not, make sure they are where they should be so the routines can find them, if you have, can you post the whole code? Maybe that way I can see more of what's happening or not happening. Also, what reference for AutoCAD do you have checked?

HTH
Todd

 

[msstrang]

msstrang (Programmer) Sep 20, 2005
here is the main code to get text from autocad. i'm running autocad 2002, but in my references it only allows for me to select autocad 2000 library from the list, but when i select this it takes the .tlb file from my acad2002 directory.
im also referencing:
visual basic for applications
microsoft excel 10.0 library
ole automation
microsoft office 10.0 library
microsoft forms 2.0 library
i really appreciate you helping me out here



Public Sub GetText(objAcad, AcadDoc)


Public objAcad As AcadApplication
Public AcadDoc As AcadDocument
Dim objSelSet As AcadSelectionSet
Dim objEnt As AcadText
Dim intType(1) As Integer
Dim varData(1) As Variant
Dim intRow As Integer
Dim varAtts As Variant
Dim MyVar As Range
Dim DB As Workbook
Dim CP As Worksheet



Set DB = Application.ActiveWorkbook
Set CP = DB.ActiveSheet

On Error GoTo Err_Handler


Set objAcad = GetObject(, AutoCAD.Application)
Set AcadDoc = objAcad.ActiveDocument
Set objSelSet = vbdPowerSet("gettext")
intType(0) = 0
varData(0) = "TEXT,MTEXT"
objSelSet.Select acSelectionSetAll, _
filtertype:=intType, filterdata:=varData
intRow = 1

For Each objEnt In objSelSet
With objEnt
CP.Cells(intRow, 1).Value = objEnt.TextString
End With
intRow = intRow + 1
Next objEnt
ThisDrawing1.ActiveSpace = acPaperSpace
Exit_Here:
Exit Sub
Err_Handler:
MsgBox Err.Number & " " & Err.Description
End Sub


and then the vbapowerset is in a seperate module

Public Function vbdPowerSet(strName As String) As AcadSelectionSet
'
' Title : vbdPowerSet
'
' Version : 1.0.0
' Author(s) : Randall Rath
' Created : 03/20/2002 01:45:37 PM
' Last Edit : 03/20/2002 01:45:37 PM, TDC
'
' Description:
' ¯¯¯¯¯¯¯¯¯¯¯¯
' This function to add a new selection set by name, and check
' for an existing selection set.
'
' Additional files/functions required:
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' 1) None
'
' Example usage:
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' Set ssTitleBlocks = vbdPowerSet("TITLEBLOCKS_SSET")
'
' Requires the following variables:
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' * Input assignments
' 1) strName - A string for any named sets within the
' drawing for vbdPowerSet to search.
'
' Updates:
' ¯¯¯¯¯¯¯¯
' 03/20/2002 01:45:37 PM - 1.0.0 - TDC
' 1) Initially created
'
' Future considerations:
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' 1) None
'
' vbdPowerSet begins here:
' ——————————————————————————————————————————————————

Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Set objSelCol = AcadDoc.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = strName Then
objSelCol.Item(strName).Delete
Exit For
End If
Next
Set objSelSet = objSelCol.Add(strName)
Set vbdPowerSet = objSelSet
End Function

 

[msstrang]

oh, and both sets of VBA code are in modules.
get text is one module, and the vbapowerset is in a seperate module.

 

[TCARPENTER]

Hi msstrang,

No problem helping out, sounds as though your references are correct - I think I see the problem:

These two lines of code should come before ANY other lines of code:

Public objAcad As AcadApplication
Public AcadDoc As AcadDocum

and then, your GetText sub should look this way:

Public Sub GetText()

You don't need to pass the variables objDoc and AcadDoc to the routine because they are defined publicly, meaning the routines can find them in memory already.

HTH
Todd

 

[msstrang]

ok, i see what you're saying now about the public variable, that makes sense.

when i put
"Public objAcad As AcadApplication" and
"Public AcadDoc As AcadDocument"
before "Public Sub GetText()" i get the following error message with excel when i run the program:

"438 Object doesn't support this property or method"

when i run the debugger the program jumps to the error handler when it reaches "Set objAcad = GetObject(, AutoCAD.Application)" in the program.

 

[TCARPENTER]

Hi msstrang,

My apologies, the line:

Set objAcad = GetObject(,AutoCAD.Application)

should read:

Set objAcad = GetObject(,[red]"[/red]AutoCAD.Application[red]"[/red])

I completely forgot the quotes.

HTH
Todd

 

[msstrang]

quite all right, the quotes did make a pretty big difference in the behavior of the program.

when i run the program now i get an excel error:
"424 object required"

when i run debugger the program skips over this "For" command:
"For Each objEnt In objSelSet"
and goes to this line in the code:
"ThisDrawing1.ActiveSpace = acPaperSpace"
and then jumps to the error handler.

 

[msstrang]

when i say skips over the "For" command i actually mean it gets to that command and then skips over the arguments within the command, sorry.

 

[TCARPENTER]

Hi msstang,

This line:

ThisDrawing1.ActiveSpace = acPaperSpace

should read:

AcadDoc.ActiveSpace = acPaperSpace

After looking at your DXF filters:

Dim intType(1) As Integer
Dim varData(1) As Variant
...
..
intType(0) = 0
varData(0) = "TEXT,MTEXT"

You might need to change them to:

Dim intType(4) As Integer
Dim varData(4) As Variant
...
..
intType(0) = -4 : varData(0) = "<or"
intType(1) = 0 : varData(1) = "TEXT"
intType(2) = 0 : varData(2) = "MTEXT"
intType(3) = -4 : varData(3) = "or>"

Note the colons are optional, I just do that to keep them grouped.

HTH
Todd

 

[msstrang]

again, thank you for all the help...

ok, no errors this time.
but no data is being transferred from autocad to excel.
when i debug and check
"objEnt"
it displays it's value as
"nothing".
and the program still does not enter the
"For Each objEnt In objSelSet"
loop and skips directly to
"AcadDoc.ActiveSpace = acPaperSpace"

 

[TCARPENTER]

Hi msstrang,

Let's try cleaning up a few things;

Clean up this chunk of code:

For Each objEnt In objSelSet
    With objEnt
        CP.Cells(intRow, 1).Value = objEnt.TextString
    End With
    intRow = intRow + 1
    Next objEnt

to this:

For Each objEnt In objSelSet
  CP.Cells(intRow, 1).Value = objEnt.TextString
  intRow = intRow + 1
Next objEnt

Then as a test to see if any text is found, put this line in just after the select statement:

objSelSet.Select acSelectionSetAll, _
filtertype:=intType, filterdata:=varData

[purple]Debug.Print "Objects found: " & objSelSet.Count[/purple]

After you make these changes, do the obvious, and make sure your test drawing actually has text/mtext and make sure the text is NOT embedded within blocks or xrefs then try the routine. Let me know how you make out.

Todd

 

[msstrang]

still no luck. the only change that occurs is that my autocad drawing changes from the "model" view to the "layout" view when my program finishes.

i'm a bit fuzzy on the vbapowerset, do we maybe have to make some of those variables public, or pass the variables from the selection set to the program?

 

[TCARPENTER]

Hi msstrang,

Hmm... does the selection set contain anything?

I think you'll need to change how the variable objEnt is dimensioned:

Dim objEnt As AcadText

to:

Dim objEnt As [purple][b]AcadEntity[/b][/purple]

And just for grins, I copied your code verbatim (with the changes I mentioned) into an Excel module (just like you mentioned you have) and it worked. The two drawings I used had just text, mtext and text, and just mtext. Just for comparison Here's what I have:

Sub GetText()
  Dim intType(4) As Integer
  Dim varData(4) As Variant
  Dim objSelSet As AcadSelectionSet
  Dim objEnt As AcadEntity
  Dim intRow As Integer
  Dim varAtts As Variant
  Dim MyVar As Range
  Dim DB As Workbook
  Dim CP As Worksheet

  intType(0) = -4: varData(0) = "<or"
  intType(1) = 0: varData(1) = "TEXT"
  intType(3) = 0: varData(3) = "MTEXT"
  intType(4) = -4: varData(4) = "or>"
    
  Set DB = Application.ActiveWorkbook
  Set CP = DB.ActiveSheet

  On Error GoTo Err_Handler

  Set objAcad = GetObject(, "AutoCAD.Application")
  Set AcadDoc = objAcad.ActiveDocument
  Set objSelSet = vbdPowerSet("gettext")

  objSelSet.Select acSelectionSetAll, _
  filtertype:=intType, filterdata:=varData
  
  Debug.Print objSelSet.Count
  
  intRow = 1
  
  For Each objEnt In objSelSet
    CP.Cells(intRow, 1).Value = objEnt.TextString
    intRow = intRow + 1
  Next objEnt
  
  AcadDoc.ActiveSpace = acPaperSpace

Exit_Here:
    Exit Sub
Err_Handler:
    MsgBox Err.Number & " " & Err.Description

End Sub

 

[msstrang]

oh my god....

you're right. i copied the code into a brand new excel worksheet, reset all my references, placed the code from above in a module, put the vbdpowerset into the same module, and added the public variables....and it works!!!!
i guess i was sorta close in the beginning, but i couldn't have done it without your help.

thanks agaign for all the help...you really came thru.

 

[TCARPENTER]

Hi msstrang,

Glad I could help!

Cheers
Todd