Bentley Autoplant changing SysID’s – a way to do so in VBA code

OK – so I FINALLY have the whole mystery solved of what happens to SySID’s (sys id’s) in the front end (generation) and use (in DWG model files). Ideally they should match – so if you can’t change the source (out of my control) let try to change the destination?? Lets investigate.

First, I have needed to understand where Bentley puts all their data in AutoCAD. Finally I have an excuse to finish my investigation. I would like to change my Sys’IDs for a set of components so that the match the Spec Gen ones. So due to a situation out of my control (we simply wanted the Long Description changed), the SyS ID’s were all changed and it is more work to get them changed at the source than just change them in the DWG or AutoPLANT model. So lets look for them, find them and change them and heck, why not change some other items along the way like that Long Description.

In this article, lets look at all the XDATA apps that Autoplant uses. It discusses how to know what they are and what all the values are. Low and behold – the storage. Currently this article does not look at changing the values – that will come VERY shortly.

Some background…

First, we originally wanted to change the long and short description but after it was changed, it became apparent that the short description triggered a SyS id change. So, we backed off and requested only a long description changed. Since there are a couple of departments involved, all has gone to hell in a handbasket (a simple restore to the orig files is not in the question either – I hate politics). So how the heck can we get back to a position where the sysid’s are going to match? Well, if you can’t change the source, can we change the destination? Perhaps. First, lets find out where all that is stored.

Finding where AutoPLANT data is stored

Yes it is in in XDATA. Lets see some code that reveals where the data is stored – in XDATA apps. Using VBA (and I am using AutoCAD 2011)

[vb]

Sub lt()

For i = 0 To ThisDrawing.Database.RegisteredApplications.Count – 1
‘ThisDrawing.Database.RegisteredApplications.Item (i)
Debug.Print ThisDrawing.Database.RegisteredApplications.Item(i).Name
Next i

End Sub

[/vb]

Next lets see some code that will go through some items on specific layers and then, using the apps that we got out above, we will see what data is where. Also – lets note that I look through the AT_GRP app twice because if it is not a valid AP component (one that starts with AT_) I am not interested. It all gets written to a file in VBA

[vb]

Sub InvestigateThis()

Dim SetsCount As Integer
Dim layer() As Variant
Dim MyType() As Integer
Dim ObjsetRef As AcadSelectionSet
Dim i As Integer
Dim ent As AcadEntity
Dim dV As Variant
Dim dType As Variant
Dim dValue As Variant
Dim TempPt As Variant

Dim app As String
Dim appCount As Integer

SetsCount = ThisDrawing.SelectionSets.Count – 1 ‘get the selection sets in the xref

ReDim MyType(3) ‘redeclare the filter to find only items we want
ReDim layer(3)
MyType(0) = -4: layer(0) = "<OR" ‘creates the filter
MyType(1) = 8: layer(1) = "LAYER_ONE" ‘layers that the lights are on
MyType(2) = 8: layer(2) = "LAYER_TWO"
MyType(3) = -4: layer(3) = "OR>"

Set ObjsetRef = Nothing
For i = 0 To SetsCount ‘check if the selection set "desired objects" exists
Set ObjsetRef = ThisDrawing.SelectionSets.Item(i)
If ObjsetRef.Name = "LightObjects" Then
ObjsetRef.Clear
Exit For
Else
Set Objset = Nothing
End If
Next
If ObjsetRef Is Nothing Then
Set ObjsetRef = ThisDrawing.SelectionSets.Add("ExperimentObjects")
End If

Dim appsList(16) As String
appsList(0) = "AT_GRP" ‘ check to see if it is an autoplant component.
appsList(1) = "AT_GRP"
appsList(2) = "AT_COMP"
appsList(3) = "AT_PROJCOMP"
appsList(4) = "AT_SPEC"
appsList(5) = "AT_SUBGRP"
appsList(6) = "AT_EXTDATA"
appsList(7) = "AT_PTS"
appsList(8) = "AT_MOD"
appsList(9) = "AT_HIGHSYM"
appsList(10) = "ACAD_PSEXT"
appsList(11) = "AT_EQP"
appsList(12) = "AT_ATT"
appsList(13) = "AT_ATT_DATA"
appsList(14) = "AT_STOP"
appsList(15) = "AT_CLDATA"
appsList(16) = "ACAD_PSEXT"

Dim FilePath As String
FilePath = "c:\temp\test.csv"

Open FilePath For Output As #1
Write #1, ""
Close #1

ObjsetRef.Select acSelectionSetAll, , , MyType, layer
If ObjsetRef.Count <> 0 Then ‘if there are items continue
For Each ent In ObjsetRef ‘repeat for all lights in the xref and get current item

For appCount = 0 To UBound(appsList)

dV = "–NULL–"

On Error Resume Next

‘ent.GetXData "AT_MOD", dType, dValue ‘BENTLY USES AT_MOD AS ONE OF ITS XDATA APP

app = appsList(appCount)
ent.GetXData app, dType, dValue
dV = dValue(0)
On Error GoTo 0
If dV <> "–NULL–" And dV <> "" Then
TempPt = 0
On Error Resume Next
TempPt = ent.InsertionPoint
On Error GoTo 0
partnum = InvestigateXdata(dType, dValue, TempPt, ent, app, appCount, FilePath)
If (partnum = "") Then
appCount = UBound(appsList) + 1
Else
If (appCount = 0) Then
Open FilePath For Append As #1
Write #1, "NewComponent::" & partnum
Close #1
Debug.Print "NewComponent::" & partnum
End If
End If

Else

End If
Next
Next ent
End If

End Sub
Function InvestigateXdata(dType As Variant, dValue As Variant, TempPt As Variant, ent As AcadEntity, app As String, appCount As Integer, FilePath As String)

Dim i As Integer
Dim Upbound As Integer
Dim UpboundV As Integer
Dim HasBOFVal As Integer

Dim Tag As String
Dim found As Integer
Dim pos1 As Integer
Dim pos2 As Integer

found = 0

UpboundV = UBound(dValue, 1)

Dim tabs As Integer

es = ""
tabs = 1

Dim tabSep As String
‘tabSep = vbTab
tabSep = "|"

Dim sep As String
sep = ""

Dim dVal As String
Dim vt As Integer
Dim oddball As Boolean

For i = 0 To UpboundV
oddball = False

vt = VarType(dValue(i))

dVal = ""
If VarType(dValue(i)) <> vbArray And VarType(dValue(i)) <> 8197 Then
dVal = CStr(dValue(i))
Else
oddball = True
End If

If Not (oddball) Then

If UCase(dVal) = "{" Then
tabs = tabs + 1
sep = tabSep
ElseIf UCase(dVal) = "}" Then
tabs = tabs – 1
sep = tabSep
Else
es = es + sep & dVal
sep = "::"
End If
If (tabs = 1) Then
sep = vbCrLf
End If
Else
es = es & "::VarType(" & VarType(dVal) & ")"
End If
Next i

If (appCount > 0) Then
For j = 1 To tabs
es = tabSep & es
Next
Open FilePath For Append As #1
Write #1, es
Close #1

End If

If (appCount = 0) Then
pos1 = InStr(1, es, "GN::AT_")
If pos1 > 0 Then
pos2 = InStr(pos1, es, tabSep)
If (pos2 = 0) Then
pos2 = Len(es) + 1
End If
InvestigateXdata = Mid(es, InStr(1, es, "GN::AT_") + 4, pos2 – pos1 + 1)
Else
InvestigateXdata = ""
End If
Else
InvestigateXdata = "validpart"
End If

End Function

[/vb]