Automation
Automation
Array Functions
Array Remove Item
lTop = UBound(ItemArray)
lBottom = LBound(ItemArray)
Exit Sub
ErrorHandler:
Err.Raise Err.Number, , _
"You must pass a resizable array to this function."
End Sub
Exists In Array
For gg = 0 To UBound(InputArray) - 1
MySel.Add InputArray(gg)
Next gg
Is array empty
failed:
isarrempty = True
End Function
filename = path
ReDim myarray(0)
counter = 0
While Not EOF(1)
lineval = ""
Line Input #1, lineval
counter = counter + 1
Wend
Close #1
End Sub
‘Comments: The text file should contain all elements separated by a delimiter such as a comma
or another type of special character. Every line should be considered an element you want in
the array.
'name,lastname,age,haircolor
'jose,guzman,34,black'
'john,doe,10,brown
'When running the function it will create an array containing 3 arrays each of which will have 4
sub elements.
'array 1 :
'1st element: name
'2nd element: lastname
'3rd element: age
'4th element: haircolor
'array 2 :
'1st element: jose
'2nd element: Guzman
'3rd element: 34
'4th element: black
'array 3 :
'1st element: john
'2nd element: doe
'3rd element: 10
'4th element: brown
Make Array From Excel Column
For MK = 2 To TotalRows
Dim CurStr As String
CurStr = CStr(CurCells(MK, ColumnNo).Value)
MakeArrayFromExcelColumn = CurArr
End Function
Reverse Array
Sort 2 Arrays
Sort Array
Excel Functions
CSVCounter = CSVCounter + 1
End If
End Sub
Is App Open
Spaces Below
Geometry Functions
Function AddLouvreWithEndOffsetByCurveFromOriginAxis(SketchProfileREF
As Reference, GuideCurve As Variant, OffsetDim As Double, ConstSet As
HybridBody, FinalSet As HybridBody) As HybridShapeSweepExplicit
Dim EndPt1 As HybridShapePointOnCurve
Set EndPt1 =
MyHSFactory.AddNewPointOnCurveFromDistance(GuideCurve, OffsetDim,
True)
ConstSet.AppendHybridShape EndPt1
MyHSFactory.GSMVisibility EndPt1, 0
Dim EndPt3 As HybridShapePointOnCurve
Set EndPt3 =
MyHSFactory.AddNewPointOnCurveFromDistance(GuideCurve, OffsetDim,
False)
ConstSet.AppendHybridShape EndPt3
MyHSFactory.GSMVisibility EndPt3, 0
Sub BatchExtrudeFromSelection()
Dim MyPart As Part
Dim MyHSFactory As HybridShapeFactory
Dim MySel As Selection
Set MyPart = CATIA.ActiveDocument.Part
Set MySel = CATIA.ActiveDocument.Selection
Set MyHSFactory = MyPart.HybridShapeFactory
If MySel.Count = 0 Then
Exit Sub
End If
For X = 1 To MySel.Count
CATIA.StatusBar = "Completed... " & Round((X / MySel.Count) *
100, 0)
Dim CurExt As HybridShapeExtrude
Set CurExt = MyHSFactory.AddNewExtrude(MySel.Item(X).Value, 0, -42
* 25.4, Zaxis)
CurSet.AppendHybridShape CurExt
CurExt.Name = MySel.Item(X).Value.Name & "_EXT"
Next
MyPart.Update
End Sub
Fillet Stabilizer
Dim FC As Boolean
FC = False
Dim SuperMatrix
ReDim SuperMatrix(15)
SuperMatrix(0) = Array(1, 1, 1, 1)
SuperMatrix(1) = Array(-1, 1, 1, 1)
SuperMatrix(2) = Array(1, -1, 1, 1)
SuperMatrix(3) = Array(-1, -1, 1, 1) '
SuperMatrix(4) = Array(1, 1, -1, 1)
SuperMatrix(5) = Array(-1, 1, -1, 1)
SuperMatrix(6) = Array(1, -1, -1, 1)
SuperMatrix(7) = Array(-1, -1, -1, 1) '
SuperMatrix(8) = Array(1, 1, 1, -1)
SuperMatrix(9) = Array(-1, 1, 1, -1)
SuperMatrix(10) = Array(1, -1, 1, -1)
SuperMatrix(11) = Array(-1, -1, 1, 1) '
SuperMatrix(12) = Array(1, 1, -1, -1)
SuperMatrix(13) = Array(-1, 1, -1, -1)
SuperMatrix(14) = Array(1, -1, -1, -1)
SuperMatrix(15) = Array(-1, -1, -1, -1)
If FC = False Then
FilletStabilizer = False
Exit Function
End If
'FilletObj.Support = inplane
MyPart.InWorkObject = FilletObj
MyPart.UpdateObject FilletObj
End Function
Dim Tmeas
Set Tmeas = TheSPAWorkbench.GetMeasurable(InputCrv)
Dim PtCoords(8)
Tmeas.GetPointsOnCurve PtCoords
MoveLineTangencyCloserToCoord TangLine, CDbl(PtCoords(3)),
CDbl(PtCoords(4)), CDbl(PtCoords(5))
IsUpdatable TangLine
ForceColorObjUgly TangLine, 30, 230, 100, 6, 1000, 1, 1000
End Sub
IsUpdatable Curve1
Dim C1Meas
Set C1Meas = TheSPAWorkbench.GetMeasurable(Curve1)
Dim C1Coords()
ReDim C1Coords(8)
C1Meas.GetPointsOnCurve C1Coords
IsUpdatable Curve2
Dim C2Meas
Set C2Meas = TheSPAWorkbench.GetMeasurable(Curve2)
Dim C2Coords()
ReDim C2Coords(8)
C2Meas.GetPointsOnCurve C2Coords
Tension Relief
Dim Meas2
Set Meas2 = TheSPAWorkbench.GetMeasurable(InputSpline)
Dim LLength2 As Double
LLength2 = Meas2.Length
If LLength < LLength2 Then
InputSpline.SetPointConstraintFromCurve 1, IntersectionCurve, 1#,
-1, 1
CATIA.ActiveDocument.Part.UpdateObject InputSpline
End If
End Sub
Math Functions
Arcos
ArcSin
Color to RGB
Cross Product
Dec 2 Fract
If X = 0 Then
Dec2Fract = ""
Exit Function
Else
Y = Abs(X)
If Y > 1 Then Y = Y - Int(Y) ' get fractional part
Num = CInt(Den * Y)
Dec2Fract = F
End If
End Function
Deg to rad
Dot Product
Function DotProduct(U, V)
temp = U(0) * V(0) + U(1) * V(1) + U(2) * V(2)
DotProduct = temp
End Function
Find 3D Distance
Get Distance
Get Slope
Get Y Intercept
Numberator
Plane Equation
RGB to Hex
End Function
Vector of line