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.
paramathma,
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.
'******************************************************************************************************
'***** 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()
AUserForm1.Show
End Sub
Sub CATStart()
Track
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
MySel.Clear
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)
Debugging…awesome.
Recent Comments