AnsweredAssumed Answered

move/copy

Question asked by Timothy Luchini on Jan 22, 2015

I am trying to write a macro in Solidworks to create an array of 100 randomly aligned disks. After I extrude one disk, I am able to use Body-Move/Copy to translate the disks in 3D to points read from a file. Once the disks have been moved I cannot rotate them around their center-point. I also cannot move and rotate the disks in the same step. My most basic question is after I have made my 100 disks how do I select the move/copy steps to then rotate the disks.

 

My macro is as follows:

 

' ******************************************************************************

' Macro To Read in Random Centerpoints for Circle Plate Geometries by luchinit

' reminder to change values of square, files locations,

' ******************************************************************************

Dim swApp As Object

Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

 

Sub main()

 

Set swApp = Application.SldWorks

 

Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2011\templates\Part.prtdot", 0, 0, 0)

swApp.ActivateDoc2 "Part1", False, longstatus

Set Part = swApp.ActiveDoc

Dim myModelView As Object

Set myModelView = Part.ActiveView

myModelView.FrameState = swWindowState_e.swWindowMaximized

Part.WindowRedraw

Part.WindowRedraw

 

Set Part = swApp.ActiveDoc

swApp.ActiveDoc.ActiveView.FrameState = 1

Dim skPoint As Object

Dim skSegment As Object

Dim Line As Object

 

' Dim myModelView As Object

Dim vSkLines As Variant

 

Set myModelView = Part.ActiveView

myModelView.FrameState = swWindowState_e.swWindowMaximized

 

' REMINDER TO UPDATE: set dimentions of square in um

square = 103.0465097

' REMINDER TO UPDATE: Plate Radius

Srad = 2

' EMINDER TO UPDATE: Plate Thickness

Thick = 0.1

' REMINDER TO UPDATE: Circle Radius

CircRad = 2.6

' REMINDER TO UPDATE: read file from this location for sphere center point generation

Open "C:\Users\VolumeFractionGeometries\100Particles\Spheres\3umParticle_20FiberVF_5.8PartVF.txt" For Input As #1

' REMINDER TO UPDATE: read file from this location for sphere center point generation

Open "C:\Users\VolumeFractionGeometries\100Particles\Spheres\3umParticle_20FiberVF_5.8PartVF.txt" For Input As #3

' REMINDER TO UPDATE: read file from this location for cylinder center point generation

Open "C:\Users\VolumeFractionGeometries\100Particles\EnergyVariationParticleGeometries\20h1e2.txt" For Input As #2

 

boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

Part.ClearSelection2 True

Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0, Srad, 0#)

Part.ClearSelection2 True

Part.SketchManager.InsertSketch True

Part.ShowNamedView2 "*Trimetric", 8

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

Dim myFeature As Object

Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, Thick, Srad, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)

Part.SelectionManager.EnableContourSelection = False

 

' Sketch and extrude plates

Do While Not EOF(1)

Input #1, X, Y, Z

myModelView.FrameState = swWindowState_e.swWindowMaximized

Set Part = swApp.ActiveDoc

Part.ShowNamedView2 "*Trimetric", 8

'boolstatus = Part.Extension.SelectByID2("Boss-Extrude1", "SOLIDBODY", 0, 0, 0, True, 0, Nothing, 0)

'Part.ClearSelection2 True

'boolstatus = Part.Extension.SelectByID2("Boss-Extrude1", "SOLIDBODY", X, Y, Z, True, 1, Nothing, 0)

'Set myFeature = Part.FeatureManager.InsertMoveCopyBody2(X, Y, Z, 0, X, Y, Z, 0, 5.75958653, 0.34906585, True, 1)

boolstatus = Part.Extension.SelectByID2("Boss-Extrude1", "SOLIDBODY", 0, 0, 0, False, 1, Nothing, 0)

Set myFeature = Part.FeatureManager.InsertMoveCopyBody2(X, Y, Z, 0, 0, 0, 0, 0, 0, 0, True, 1)

Part.ClearSelection2 True

Loop

Close #1

 

' Rotate Plates

Do While Not EOF(3)

Input #1, X, Y, Z

Input #3, A, B, C

myModelView.FrameState = swWindowState_e.swWindowMaximized

Set Part = swApp.ActiveDoc

Part.ShowNamedView2 "*Trimetric", 8

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Boss-Extrude1[]", "SOLIDBODY", X, Y, Z, False, 1, Nothing, 0)

Set myFeature = Part.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, X, Y, Z, A, B, C, False, 1)

Loop

Close #1

Close #3

 

End Sub

Outcomes