First time automatisation (changing text) ACAD2012

[dee2me]

Hi,

I'm trying to automate something that takes a lot of time at my company.

We got a lot of P&ID drawings full of tags. I want to automate the modification of tags according to an excel table.

I got something working but it's not reliable. It often doesn't work and it's very slow.

Please comment on it. I'm no programmer besides some programming classes back in school.

The form I call from.

It's function is to let the user pick which P&ID's should be put in the modification loop.

It's just a listbox (filenames), a textbox (for the file location) and a button.

Private Sub CommandButton1_Click()
Dim vtPid As Variant
ReDim vtPid(0)
Dim i As Integer, j As Integer

    j = 0
    For i = 0 To lstPid.ListCount - 1
        If lstPid.Selected(i) = True Then
            ReDim Preserve vtPid(j)
            vtPid(j) = lstPid.List(i)
            j = j + 1
        End If
    Next

frmPidTag.Hide
Call Modifie_PIDTag(vtPid, txtLocation.Text)
End Sub

The code is in my module.

First I open the excel (table with 2 columns, old and new tag) and put the table in an array.

The array is then used cycle through al entities.

[b] I'm trying to change certain text located in the layer "instrumentation".[/b] It's just text strings, no blocks or anything.

I'd like to use another method to get only the entities with possible matches but this seems to be the only reliable method. Only cycling textstrings would be better.

Sub Modifie_PIDTag(ByVal vtPid As Variant, ByVal varLocation As String)
' Create the Excel object
Dim oExcel As Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim aryPID()
Dim LastRow As Integer
Dim LastColumn As Integer

' Open existing workbook
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(varLocation & "EXCEL\DrawingData.xlsx")

'Set oExcel = New Excel.Application
oExcel.Visible = False
    
' Open worksheet
Set oSheet = oBook.Worksheets("PIDtag")
oSheet.Activate

' Read Excel
LastColumn = oSheet.Cells(1, oSheet.Columns.count).End(xlToLeft).Column
LastRow = oSheet.Cells(oSheet.Rows.count, 1).End(xlUp).Row

ReDim aryPID(1 To LastRow, 1 To LastColumn)
aryPID = oSheet.Range(oSheet.Cells(1, 1), oSheet.Cells(LastRow, LastColumn))
  
' Cleanup
oBook.Close
oExcel.Quit
Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing

' Create the Autocad object
On Error Resume Next
    Set objAcadApp = GetObject(, "AutoCAD.Application")
    If Err Then
        Err.Clear
        MsgBox ("AutoCAD is not running...")
    End
    Else
        Set objAcadDoc = objAcadApp.ActiveDocument
        Set objMspace = objAcadDoc.ModelSpace
    End If

Dim Entity As AcadEntity
Dim Doc As AcadDocument
Dim i As Integer, j As Integer
Dim saveloc As String

For j = 0 To UBound(vtPid)
    'MsgBox vtPid(j)
    On Error Resume Next
    Set Doc = Documents.Open(varLocation & "TEMPLATE\" & vtPid(j) & ".dwg", False)
    If Err Then
    MsgBox "error"
    Err.Clear
    End
    Else
    
    AppActivate objAcadApp.Caption
    
    i = 0
    For Each Entity In Doc.ModelSpace
        If (Entity.Layer = "INSTRUMENTATION") And (Entity.EntityName = "AcDbAttributeDefinition") Then
            For i = LBound(aryPID) + 1 To UBound(aryPID)
                If Entity.TagString = CStr(aryPID(i, 1)) Then
                    Entity.TagString = CStr(aryPID(i, 2))
                End If
            Next
        End If
    Next
    
saveloc = varLocation & "\DWG\" & vtPid(j) & "-new.dwg"
ThisDrawing.SaveAs saveloc
ThisDrawing.Close
End If
Next
End Sub

The get/create autocad object may seem out of place there but it was the only way to solve an error.

Calling the subroutine from a form gave me automation errors. I think it was a focus/activation problem. Anyway, this seems to solve it.

Thanks!

[dee2me]

Ok, I created a selectionset to lessen the amount of entities I need to loop through.

   Dim sset As AcadSelectionSet
   Set sset = ThisDrawing.SelectionSets.Add("FilterSet1")
   
   Dim filterType As Variant
   Dim filterData As Variant
   Dim p1(0 To 2) As Double
   Dim p2(0 To 2) As Double
   
   Dim grpCode(0) As Integer
   grpCode(0) = 8
   filterType = grpCode
   
   Dim grpValue(0) As Variant
   grpValue(0) = "INSTRUMENTATION"
   filterData = grpValue
    
   sset.Select acSelectionSetAll, p1, p2, filterType, filterData
   For Each Entity In sset
        If Entity.EntityName = "AcDbAttributeDefinition" Then
            For i = LBound(aryPID) + 1 To UBound(aryPID)
                If Entity.TagString = CStr(aryPID(i, 1)) Then
                   Entity.TagString = CStr(aryPID(i, 2))
                End If
            Next
        End If
    Next

This doesn't seem to help.

Autocad still does what it wants. Sometimes it executes, sometimes it doesn't.

It's like VBA is executing really fast and autocad can't keep up.

[truss_85]

"It's like VBA is executing really fast and autocad can't keep up." I am affraid, that is not possible. VBA does not execute anything fast. The real reaseon is VBA did not catch Autocad may be.

Can I ask you which operation system you have? If it is 64 bit vba does not support properly. There is something like VBA 64 bit server it delays everything. May be that is the reason it too slow working. Microsoft did not support VBA any more. Visual Studio suggested for any furter application.

[dee2me]

Windows 7 64b.

Visual studio would mean I'd have to create standalone apps.

I just want to automate some cheap tricks. I do it all the time in Excel/Word/Access

Any other language I can use that is supported? It can't be any more basic as VB.

[truss_85]

It did not mean standalone application. May be I missunderstood microsoft does not support Visual Basic for Application in other terms VBA. You can still use visual basic language but in a different platform.  In VBA you create .dvb file, in vb.net you can create Visual Studio has also support visual basic. You can use express edition for both office and cad documents or may be lisp will do it.

[truss_85]

For further information  Check this

[dee2me]

I changed EntityName to ObjectName and moved everything to Access.

It works fast enough in Access.

Go figure.

[truss_85]

Also you can modify your selection set type of object "0" group code and attribute def.

It possibly run faster