Hello,
I have a macros file that manages to run without any runtime errors. However, the macros doesn't perform the same when I run it on the newer 2018 version Unfortunately I can't reinstall the 2016 version.
That made me think that the problem is not with the code, but maybe some libraries or updated-syntax problem.
The code is intended to read several text files that were originated in MATALB.
The first file creates the rectangular shape.
The other files contain the spheres' XYZ coordinates and sizes.
For each of the 3 sphere types there is a function (CallAddSpheres, CallAddSpheres2, CallAddSpheres3).
I will appreciate any help.
Please find attached my macros code:
(It's a bit long but the functions repeat themselves from one type of sphere to another).
Option Explicit
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Sub main()
Set swApp = _
Application.SldWorks
Dim L As Double, H As Double, B As Double, D As Double
Open "G:\My Drive\CALCE\Matlab\BugCheking\bugCheck\JointSpace.txt" For Input As #4
Input #4, L, H, B
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
boolstatus = Part.Extension.SelectByID2("Front", "PLANE", -0.015290540458011, 0.117423464842034, 0.100349923680369, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
Dim vSkLines As Variant
vSkLines = Part.SketchManager.CreateCornerRectangle(0, 0, 0, 5.25175614406384E-02, 4.50560499791269E-02, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Line3", "SKETCHSEGMENT", 0.02152359075436, 4.47690687690688E-02, 0, False, 0, Nothing, 0)
Dim myDisplayDim As Object
Set myDisplayDim = Part.AddDimension2(2.12366095443018E-02, 5.73962420116266E-02, 0)
Part.ClearSelection2 True
Dim myDimension As Object
'Set myDimension = Part.Parameter("D1@Sketch1")
'myDimension.SystemValue = L
Part.Parameter("D1@Sketch1").SystemValue = L
boolstatus = Part.Extension.SelectByID2("Line4", "SKETCHSEGMENT", 0.120655737704918, 6.81967213114754E-02, 0, False, 0, Nothing, 0)
Set myDisplayDim = Part.AddDimension2(0.162622950819672, 7.40983606557377E-02, 0)
boolstatus = Part.Extension.SelectByID2("D1@Sketch1@Part11.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
'Set myDimension = Part.Parameter("D2@Sketch1")
'myDimension.SystemValue = H
Part.Parameter("D2@Sketch1").SystemValue = H
Part.ClearSelection2 True
Part.ShowNamedView2 "*Trimetric", 8
Part.ClearSelection2 True
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, B, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
Part.ClearSelection2 True
'myDimension.SystemValue = 0.015
Close #4
'D1@Boss-Extrude1
Dim skPoint As SldWorks.SketchPoint
Dim X As Double, Y As Double, Z As Double
Set swApp = Application.SldWorks
Set swModelDoc = swApp.ActiveDoc
swApp.ActiveDoc.ActiveView.FrameState = 1
Open "G:\My Drive\CALCE\Matlab\BugCheking\bugCheck\Particle_1_Coordinates.txt" For Input As #1
swModelDoc.SketchManager.Insert3DSketch True
Do While Not EOF(1)
Input #1, X, Y, Z
Set skPoint = swModelDoc.SketchManager.CreatePoint(X, Y, Z)
Loop
Close #1
Call AddSpheres(X, Y, Z)
Open "G:\My Drive\CALCE\Matlab\BugCheking\bugCheck\Particle_2_Coordinates.txt" For Input As #2
swModelDoc.SketchManager.Insert3DSketch True
Do While Not EOF(2)
Input #2, X, Y, Z
Set skPoint = swModelDoc.SketchManager.CreatePoint(X, Y, Z)
Loop
Close #2
Call AddSpheres2(X, Y, Z)
Open "G:\My Drive\CALCE\Matlab\BugCheking\bugCheck\Particle_3_Coordinates.txt" For Input As #3
swModelDoc.SketchManager.Insert3DSketch True
Do While Not EOF(3)
Input #3, X, Y, Z
Set skPoint = swModelDoc.SketchManager.CreatePoint(X, Y, Z)
Loop
Close #3
Call AddSpheres3(X, Y, Z)
swModelDoc.ShowNamedView2 "*Isometric", 7
swModelDoc.ViewZoomtofit2
End Sub
Sub AddSpheres(X As Double, Y As Double, Z As Double)
Dim swFeat As SldWorks.Feature
Dim swFeatMgr As SldWorks.FeatureManager
Dim skSegment As SldWorks.SketchSegment
Dim swDispDim As SldWorks.DisplayDimension
Dim bStatus As Boolean
Dim D As Double
Open "G:\My Drive\CALCE\Matlab\BugCheking\bugCheck\Particle_1_Size.txt" For Input As #4
Input #4, D
Const dblRadius As Double = 0.000001 'Radius of sphere in meters
Set swFeatMgr = swModelDoc.FeatureManager
'Select "Front" plane
bStatus = swModelDoc.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, _
False, 0, Nothing, 0)
'Insert new sketch
swModelDoc.SketchManager.InsertSketch True
'Create arc
Set skSegment = swModelDoc.SketchManager.CreateArc(0, 0, 0, 0, D, 0, _
0, -D, 0, -1)
'Add vertical line
Set skSegment = swModelDoc.SketchManager.CreateLine(0, D, 0, _
0, -D, 0)
'Add arc center point to current selection
bStatus = swModelDoc.Extension.SelectByID2("", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
'Add "Midpoint" relation between arc center point and vertical center line
swModelDoc.SketchAddConstraints "sgATMIDDLE"
'Clear selections
swModelDoc.ClearSelection2 True
'Select vertical line
bStatus = swModelDoc.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 0, 0, 0, _
True, 0, Nothing, 0)
'Add dimension
'Set swDispDim = swModelDoc.AddDimension2(-D, 0, 0)
'Exit sketch
swModelDoc.InsertSketch2 True
'Add Revolve feature
bStatus = swModelDoc.Extension.SelectByID2("Sketch2", "SKETCH", 0, 0, 0, _
False, 0, Nothing, 0)
bStatus = swModelDoc.Extension.SelectByID2("Line1@Sketch2", "SKETCHSEGMENT", _
0, 0, 0, True, 4, Nothing, 0)
Set swFeat = swModelDoc.FeatureManager.FeatureRevolve2(True, True, False, False, False, _
False, 0, 0, 6.28318530718, 0, False, False, 0.01, 0.01, 0, 0, 0, False, True, True)
'Clear selections
swModelDoc.ClearSelection2 True
'Get the body
bStatus = swModelDoc.Extension.SelectByID2("Revolve1", "SOLIDBODY", 0, 0, 0, _
True, 1, Nothing, 0)
'Move the body to the first point
Set swFeat = swFeatMgr.InsertMoveCopyBody2(X, Y, Z, 0, 0, 0, 0, 0, 0, 0, False, 1)
'Clear selections
swModelDoc.ClearSelection2 True
'Get the body and 3D sketch
bStatus = swModelDoc.Extension.SelectByID2("Body-Move/Copy1", "SOLIDBODY", 0, 0, 0, _
True, 256, Nothing, 0)
bStatus = swModelDoc.Extension.SelectByID2("3DSketch1", "SKETCH", 0, 0, 0, _
True, 64, Nothing, 0)
'Pattern the body
Set swFeat = swFeatMgr.FeatureSketchDrivenPattern(True, False)
Close #4
End Sub
Sub AddSpheres2(X As Double, Y As Double, Z As Double)
Dim swFeat As SldWorks.Feature
Dim swFeatMgr As SldWorks.FeatureManager
Dim skSegment As SldWorks.SketchSegment
Dim swDispDim As SldWorks.DisplayDimension
Dim bStatus As Boolean
Dim D As Double
Open "G:\My Drive\CALCE\Matlab\BugCheking\bugCheck\Particle_2_Size.txt" For Input As #4
Input #4, D
Const dblRadius As Double = 0.000001 'Radius of sphere in meters
Set swFeatMgr = swModelDoc.FeatureManager
'Select "Front" plane
bStatus = swModelDoc.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, _
False, 0, Nothing, 0)
'Insert new sketch
swModelDoc.SketchManager.InsertSketch True
'Create arc
Set skSegment = swModelDoc.SketchManager.CreateArc(0, 0, 0, 0, D, 0, _
0, -D, 0, -1)
'Add vertical line
Set skSegment = swModelDoc.SketchManager.CreateLine(0, D, 0, _
0, -D, 0)
'Add arc center point to current selection
bStatus = swModelDoc.Extension.SelectByID2("", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
'Add "Midpoint" relation between arc center point and vertical center line
swModelDoc.SketchAddConstraints "sgATMIDDLE"
'Clear selections
swModelDoc.ClearSelection2 True
'Select vertical line
bStatus = swModelDoc.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 0, 0, 0, _
True, 0, Nothing, 0)
'Add dimension
'Set swDispDim = swModelDoc.AddDimension2(-D, 0, 0)
'Exit sketch
swModelDoc.InsertSketch2 True
'Add Revolve feature
bStatus = swModelDoc.Extension.SelectByID2("Sketch3", "SKETCH", 0, 0, 0, _
False, 0, Nothing, 0)
bStatus = swModelDoc.Extension.SelectByID2("Line1@Sketch3", "SKETCHSEGMENT", _
0, 0, 0, True, 4, Nothing, 0)
Set swFeat = swModelDoc.FeatureManager.FeatureRevolve2(True, True, False, False, False, _
False, 0, 0, 6.28318530718, 0, False, False, 0.01, 0.01, 0, 0, 0, False, True, True)
'Clear selections
swModelDoc.ClearSelection2 True
'Get the body
bStatus = swModelDoc.Extension.SelectByID2("Revolve2", "SOLIDBODY", 0, 0, 0, _
True, 1, Nothing, 0)
'Move the body to the first point
Set swFeat = swFeatMgr.InsertMoveCopyBody2(X, Y, Z, 0, 0, 0, 0, 0, 0, 0, False, 1)
'Clear selections
swModelDoc.ClearSelection2 True
'Get the body and 3D sketch
bStatus = swModelDoc.Extension.SelectByID2("Body-Move/Copy2", "SOLIDBODY", 0, 0, 0, _
True, 256, Nothing, 0)
bStatus = swModelDoc.Extension.SelectByID2("3DSketch2", "SKETCH", 0, 0, 0, _
True, 64, Nothing, 0)
'Pattern the body
Set swFeat = swFeatMgr.FeatureSketchDrivenPattern(True, False)
Close #4
End Sub
Sub AddSpheres3(X As Double, Y As Double, Z As Double)
Dim swFeat As SldWorks.Feature
Dim swFeatMgr As SldWorks.FeatureManager
Dim skSegment As SldWorks.SketchSegment
Dim swDispDim As SldWorks.DisplayDimension
Dim bStatus As Boolean
Const dblRadius As Double = 0.01 'Radius of sphere in meters
Dim D As Double
Open "G:\My Drive\CALCE\Matlab\BugCheking\bugCheck\Particle_3_Size.txt" For Input As #4
Input #4, D
Set swFeatMgr = swModelDoc.FeatureManager
'Select "Front" plane
bStatus = swModelDoc.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, _
False, 0, Nothing, 0)
'Insert new sketch
swModelDoc.SketchManager.InsertSketch True
'Create arc
Set skSegment = swModelDoc.SketchManager.CreateArc(0, 0, 0, 0, D, 0, _
0, -D, 0, -1)
'Add vertical line
Set skSegment = swModelDoc.SketchManager.CreateLine(0, D, 0, _
0, -D, 0)
'Add arc center point to current selection
bStatus = swModelDoc.Extension.SelectByID2("", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
'Add "Midpoint" relation between arc center point and vertical center line
swModelDoc.SketchAddConstraints "sgATMIDDLE"
'Clear selections
swModelDoc.ClearSelection2 True
'Select vertical line
bStatus = swModelDoc.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 0, 0, 0, _
True, 0, Nothing, 0)
'Add dimension
'Set swDispDim = swModelDoc.AddDimension2(-D, 0, 0)
'Exit sketch
swModelDoc.InsertSketch2 True
'Add Revolve feature
bStatus = swModelDoc.Extension.SelectByID2("Sketch4", "SKETCH", 0, 0, 0, _
False, 0, Nothing, 0)
bStatus = swModelDoc.Extension.SelectByID2("Line1@Sketch4", "SKETCHSEGMENT", _
0, 0, 0, True, 4, Nothing, 0)
Set swFeat = swModelDoc.FeatureManager.FeatureRevolve2(True, True, False, False, False, _
False, 0, 0, 6.28318530718, 0, False, False, 0.01, 0.01, 0, 0, 0, False, True, True)
'Clear selections
swModelDoc.ClearSelection2 True
'Get the body
bStatus = swModelDoc.Extension.SelectByID2("Revolve3", "SOLIDBODY", 0, 0, 0, _
True, 1, Nothing, 0)
'Move the body to the first point
Set swFeat = swFeatMgr.InsertMoveCopyBody2(X, Y, Z, 0, 0, 0, 0, 0, 0, 0, False, 1)
'Clear selections
swModelDoc.ClearSelection2 True
'Get the body and 3D sketch
bStatus = swModelDoc.Extension.SelectByID2("Body-Move/Copy3", "SOLIDBODY", 0, 0, 0, _
True, 256, Nothing, 0)
bStatus = swModelDoc.Extension.SelectByID2("3DSketch3", "SKETCH", 0, 0, 0, _
True, 64, Nothing, 0)
'Pattern the body
Set swFeat = swFeatMgr.FeatureSketchDrivenPattern(True, False)
Close #4
End Sub
Sincerely,
Gilad Nave
