Home » Engineering

Solidworks

12 December 2007 No Comment

Generates an arbitrary circle in space.

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Dim Annotation As Object
Dim Gtol As Object
Dim DatumTag As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Dim Entity As Object

Public selMgr As SelectionMgr

Sub main()

Dim SketchPoints As Variant
Set swApp = Application.SldWorks
Set Part = swApp.NewDocument(”c:\Program Files\SolidWorks\data\templates\Part.prtdot”, 0, 0#, 0#)
Dim SketchFeature As Feature

Dim MathUtil As MathUtility
Dim MathTrans As MathTransform
Dim MathP As MathPoint
Dim ModelSketchTransform As Variant

Set MathUtil = swApp.GetMathUtility
Set selMgr = Part.SelectionManager

Dim a(2)      As Double
Dim b(2)       As Double

a(0) = 0.48
a(1) = 0.135
a(2) = 0.0627
b(0) = 0.48
b(1) = 0.135
b(2) = 0.3727

Part.Insert3DSketch
Part.CreateLine2 a(0), a(1), a(2), b(0), b(1), b(2)
Part.InsertSketch2 True
Part.ClearSelection

boolstatus = Part.Extension.SelectByID(”", “EXTSKETCHPOINT”, a(0), a(1), a(2), True, 0, Nothing)
boolstatus = Part.Extension.SelectByID(”", “EXTSKETCHSEGMENT”, (a(0) + b(0)) / 2, (a(1) + b(1)) / 2, (a(2) + b(2)) / 2, True, 0, Nothing)
Part.CreatePlanePerCurveAndPassPoint3 False, True

’selects plane and draws circle
boolstatus = Part.Extension.SelectByID(”Plane2″, “PLANE”, 0, 0, 0, True, 0, Nothing)
Part.InsertSketch2 True
Part.CreateCircle 0, 0, 0, 0.02, 0, 0
Part.InsertSketch2 True
Part.ClearSelection

Part.ViewZoomtofit2

Part.SaveAs2 “c:\LeftWish_Upper.SLDPRT”, 0, False, False

End Sub

Leave your response!

You must be logged in to post a comment.