Solidworks
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.