Once again, I received a good technical question about one of my codes on the GTWiki.  This time, the user found a bug when they ran the script on  a series of objects.  Here’s their question:

I ran the code. After selecting geometrical set and Axis system and clicking on run, the macro throws up an error It stops at

Set ZMeas = TheSPAWorkbench.GetMeasurable(MySel.Item(1).Value)

I do not know the problem.

I looked into the question, and my first concern that both parts have Axis Systems.  In most cases, DP/CATIA CAD managers set Axis Systems in CATParts as a company standard.  However, if you are working with IT support or a set of unconventional standards, your settings may be missing Axis Systems per part.  You’ll receive a VB error if your Axis Systems are not in the Axis System Set at the top of the specifications tree. If they are in Geometrical Sets, then you may get this error.  User’s can fix this setting by creating a new Axis System and unchecking the option at the bottom of the dialog that places it in a Geometrical Set.  (I find this setting to be poorly placed:  I believe DS should put this command in the Tools > Options, but for now, it’s there).  From then on, all new CATParts will have an Axis at the top of the tree.

Non Standard Axis System Output.  Image GTWIKI, by Nick Pisca 2008.

Non Standard Axis System Output. Image GTWIKI, by Nick Pisca 2008.

'*****  Measure XYZ from other Axis Sys
'*****  Author:  Nick Pisca
'*****  Support:  nicholas.pisca@gehrytechnologies.com & nickpisca@gmail.com
'*****  Date:  Halloween...., 2008   Boooo wahh wahhh
'*****  Description:
'*****  Status:  In-Prog. and Working
'*****  Advancements:
'*****  Requirements:
'*****  Compatibility:  V1R3 SP8.2.2

'*****  Declarations

Dim ActDoc As Document
Dim ActProds As Products
Dim AvailDocs As Documents

Dim MySel As Selection
Dim MyPart As Part
Dim TheSPAWorkbench
Dim MyHSFactory As HybridShapeFactory
Dim ShapeFactory As ShapeFactory
Dim Zaxis As HybridShapeDirection
Dim MyRels As Relations
Dim MyParms As Parameters
Dim XYPl
Dim FS 'as FileSystem
Dim OriginPt 'As HybridShapePointCoord
Dim LouvreSK 'As Sketch
Dim LouvreSKREF As Reference
Dim MainAxisSys As AxisSystem
Dim DriverSrf
Dim randAxis As HybridShapeDirection
Dim SolBody As Body
Dim SelArr()

Sub catmain()
End Sub

Sub CATStart()
Set MyPart = CATIA.ActiveDocument.Part
Set MySel = CATIA.ActiveDocument.Selection
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
    MsgBox "Open your model in a Part or in a new window.  "
    Exit Sub
End If
Set MyHSFactory = MyPart.HybridShapeFactory
Set ShapeFactory = MyPart.ShapeFactory
Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
Set Zaxis = MyHSFactory.AddNewDirectionByCoord(0, 0, 1)
Set randAxis = MyHSFactory.AddNewDirectionByCoord(0.7777, 0.822, 0.921)
Set MainAxisSys = MyPart.AxisSystems.Item(1)

If MySel.Count <> 0 Then
End If

Dim MyAxis As AxisSystem
Set MyAxis = AUserForm1.SelAxis    ' MyPart.FindObjectByName("Axis System.2")
Dim PtSet As HybridBody
Set PtSet = AUserForm1.SelPtSet    'MyPart.FindObjectByName("Geometrical Set.1")

MySel.Add MyAxis
MySel.Search ("Type=Topology.face,sel")
'Dim FaceArr()
'ReDim FaceArr(2)
'For X = 0 To 2
'    Set facarr(X) = MySel.Item(X + 1).Value
'Next X
Dim ZMeas
Set ZMeas = TheSPAWorkbench.GetMeasurable(MySel.Item(1).Value)
Dim XMeas
Set XMeas = TheSPAWorkbench.GetMeasurable(MySel.Item(2).Value)
Dim YMeas
Set YMeas = TheSPAWorkbench.GetMeasurable(MySel.Item(3).Value)

Dim TempSet As HybridBody
Set TempSet = MyPart.HybridBodies.Add
TempSet.Name = "Temp_SET"
Dim TextXYOff As HybridShapePlaneOffset
Set TextXYOff = MyHSFactory.AddNewPlaneOffset(MySel.Item(1).Value, 1, False)
TempSet.AppendHybridShape TextXYOff
IsUpdatable TextXYOff
Dim ZMeasOff
Set ZMeasOff = TheSPAWorkbench.GetMeasurable(TextXYOff)
Dim TextZYOff As HybridShapePlaneOffset
Set TextZYOff = MyHSFactory.AddNewPlaneOffset(MySel.Item(2).Value, 1, False)
TempSet.AppendHybridShape TextZYOff
IsUpdatable TextZYOff
Dim XMeasOff
Set XMeasOff = TheSPAWorkbench.GetMeasurable(TextZYOff)
Dim TextZXOff As HybridShapePlaneOffset
Set TextZXOff = MyHSFactory.AddNewPlaneOffset(MySel.Item(3).Value, 1, False)
TempSet.AppendHybridShape TextZXOff
IsUpdatable TextZXOff
Dim YMeasOff
Set YMeasOff = TheSPAWorkbench.GetMeasurable(TextZXOff)

For ptcounter = 1 To PtSet.HybridShapes.Count
    StatusBarShort ptcounter - 1, PtSet.HybridShapes.Count, "Measuring Coords against selected axis...   "
    Dim CurPt
    Set CurPt = PtSet.HybridShapes.Item(ptcounter)
    If IsUpdatable(CurPt) Then
        Dim xDist As Double
        xDist = XMeas.GetMinimumDistance(CurPt)
        Dim xDistOff As Double
        xDistOff = XMeasOff.GetMinimumDistance(CurPt)
        If xDistOff > xDist Then
            xDist = (-1) * xDist
        End If
        AppendLengthParm CurPt, (MyAxis.Name & "_LOCALX"), xDist, MyPart

        Dim zDist As Double
        zDist = ZMeas.GetMinimumDistance(CurPt)
        Dim zDistOff As Double
        zDistOff = ZMeasOff.GetMinimumDistance(CurPt)
        If zDistOff > zDist Then
            zDist = (-1) * zDist
        End If
        AppendLengthParm CurPt, (MyAxis.Name & "_LOCALY"), zDist, MyPart

        Dim yDist As Double
        yDist = YMeas.GetMinimumDistance(CurPt)
        Dim yDistOff As Double
        yDistOff = YMeasOff.GetMinimumDistance(CurPt)
        If yDistOff > yDist Then
            yDist = (-1) * yDist
        End If
        AppendLengthParm CurPt, (MyAxis.Name & "_LOCALZ"), yDist, MyPart

    End If
Next ptcounter

MyHSFactory.DeleteObjectForDatum TextZYOff
MyHSFactory.DeleteObjectForDatum TextZXOff
MyHSFactory.DeleteObjectForDatum TextXYOff

End Sub

Sub AppendLengthParm(CurObj As Variant, ParmName As String, ParmValue As Double, CurPart As Part)
Dim CFParms As Parameters
Set CFParms = CurPart.Parameters.SubList(CurObj, True)
Dim CFStrParm As Parameter
Set CFStrParm = CFParms.CreateDimension(ParmName, "LENGTH", ParmValue)      '.CreateString(ParmName, ParmValue)
End Sub

If one wanted to debug the aforementioned problem at the line:

Set ZMeas = TheSPAWorkbench.GetMeasurable(MySel.Item(1).Value)

it usually means that either you don’t have a selection or the object selected doesn’t exist.  Immediately prior to this line, there is a selection query (the worst f-ing command in all of CATIA VB) and this command regularly changes for each build number.  BN 17-19 usually look like this:

MySel.Search ("Type=Topology.face,sel")

while, pre-BN 17 searches sometimes looks like this:

MySel.Search ("Topology.face,sel")

These changes are not expressed in DS’s release notes, nor are they formally documented.  At best, you’ll find these string references on forums or sites like by awesome blog.  🙂

Lastly, if this line doesn’t work, sometimes your SPAWorkbench reference isn’t loaded.  Check this out of your Visual Basic Editor libraries list.

Set ZMeas = TheSPAWorkbench.GetMeasurable(MySel.Item(1).Value)