ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
vsvivek singh28/04/2009
hello
this is my first time in this forum, actually my requirement is to make macro to extract coordinates of a point on a helical path on any cylindrical cad model and put them in notepad as x, y , z

i use procedure of placing a datum plane on right plane and an angular datum plane on top plane now get an intersection curve which include cad model and both datum plane now placing a refrence point on intersection of curve and model and place a refrence point there.

problem is to make macro which increase my right datum plane translationally and a top datum plane angularly so that it keep record of new refrence point. i can do this manually by changing the value but i want to make macro for it.

and simultaneously record the cordinates of refrence point in a notepad as x,y,z value

i have record this macro for it

Option Explicit

' ******************************************************************************
' C:\DOCUME~1\PALSON~1\LOCALS~1\Temp\swx2164\Macro1.swb - macro recorded on 04/27/09 by palsonmotors
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim x As Double

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Right Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateCircle(-0#, 0#, 0#, 0.00296, -0.027624, 0#)
Part.ClearSelection2 True
Part.SketchManager.InsertSketch True
Part.ShowNamedView2 "*Trimetric", 8
Part.SketchManager.InsertSketch True
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, 0.1, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
boolstatus = Part.Extension.SelectByID2("", "FACE", 0, 0.01123516211538, -0.01041684329283, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Point1@Origin", "EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.InsertAxis2(True)
boolstatus = Part.Extension.SelectByID2("Right Plane", "PLANE", 0, 0, 0, True, 0, Nothing, 0)

x = 0
Do While Not (x = 0.1)

Dim myRefPlane As Object
Set myRefPlane = Part.CreatePlaneAtOffset3(x, False, True)
x = x + 0.05
Loop


Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Plane3", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Top Plane", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Axis1", "AXIS", 0.0114187047518, -0.03566390952229, -0.0353386394927, True, 0, Nothing, 0)


x = 0
Do While Not (x = 360)
Dim mynewplane As Object

Set mynewplane = Part.CreatePlaneAtAngle3(x, False, True)
x = x + 10
Loop



Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Plane4", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Axis1", "AXIS", 0.0114187047518, -0.03566390952229, -0.0353386394927, True, 0, Nothing, 0)
Part.Sketch3DIntersections
boolstatus = Part.Extension.SelectByID2("Plane3", "PLANE", -0.04237964859755, 0.1241477175797, 0.0241616861743, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("", "FACE", 0.01096882963503, 0.02507984115402, -0.01195155237355, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Plane4", "PLANE", -0.06247353912761, 0.1000316896241, 0.02338596259278, True, 0, Nothing, 0)
Part.Sketch3DIntersections
Part.ClearSelection2 True
Part.ClearSelection2 True
Part.SketchManager.InsertSketch True
boolstatus = Part.Extension.SelectByID2("Arc2@3DSketch4", "EXTSKETCHSEGMENT", 0.02, 0.002126591316503, 0.02770046291709, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line3@3DSketch4", "EXTSKETCHSEGMENT", 0.01799857222744, 0, 0.02778197322813, True, 0, Nothing, 0)

Dim XYZ As Variant
Dim Feature As SldWorks.Feature
Dim MathPoint As SldWorks.MathPoint
Dim RefPoint As SldWorks.RefPoint
Dim vRefPointFeatureArray As Variant

vRefPointFeatureArray = Part.FeatureManager.InsertReferencePoint(6, 0, 0.01, 1) ' i am getting an error here

'Set Feature = vRefPointFeatureArray(0)
'Set RefPoint = Feature.GetSpecificFeature2
'Set MathPoint = RefPoint.GetRefPoint
'XYZ = MathPoint.ArrayData
'Set MathPoint = Nothing
'Set RefPoint = Nothing
'Set Feature = Nothing
'Part.Extension.DeleteSelection2 (2)
'MsgBox "X: " & XYZ(0) & vbCrLf & "Y: " & XYZ(1) & vbCrLf & "Z: " & XYZ(2)
End Sub