macro to extract point on helical path on cad model

95 views
Skip to first unread message

vivek

unread,
Apr 28, 2009, 12:36:33 PM4/28/09
to SolidWorks-API
hello all:

actually i am new to vb and solidworks api, :D just 1 month old you
can say . let me start with problem definition

THINGS I WANT TO DO:

my aim is to get x,y,z position of points on a helical path through
out cylinder from one end to other , i have tried many thing like
saving it to .step file format and then extracting the point position
from that file by STEP READER and then arranging them in a helical
path by getting an intersection of it by very mathematical procedure
using with NURBS curve.
But my teacher suggest me to write macro for it in solidwoks so that i
could use cad software to get me those point which can be machined

MY OWN PROCEDURE

I am not sure whether this is the right way but i can only think of
this procedure only :|
if you have any other suggestion please feel free to reply


Here i have selected an datum plane on right plane and start from 0 to
complete lenth of part with some offsets.One plane i've selected on
top plane with angular displacement with the axis from 0 to 360
now i have selected a interference curve with both datum
plane and the model, on that i have selected a reference point on the
both interference plane , now as i move one translational of right
plane and an angular displacement of one to top plane my reference
moves along the helical path till the end .

now i want to create macro for it to record each new x,y,z position of
reference plane in helical path and most importantly keep it in
notepad as .txt.

my recorded macro:

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

[h]vRefPointFeatureArray = Part.FeatureManager.InsertReferencePoint(6,
0, 0.01, 1)[/h] ' 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




i have got run time error61704 debug shows this line highlighted
[b]vRefPointFeatureArray = Part.FeatureManager.InsertReferencePoint
(6, 0, 0.01, 1) [/b]

and please tell me how to put this on notepad as .txt. if you need
more specific information please let me know

i am using solidworks 2009 standard

can i use getrayintersectionspoints funclion i have found on api help

:Gets the intersection point information generated by
IModelDoc2::RayIntersections

thank you
VIVEK PAL SINGH
ME(CAD CAM & ROBOTICS)
INDIA




vivek

unread,
Apr 28, 2009, 12:37:51 PM4/28/09
to SolidWorks-API
Reply all
Reply to author
Forward
0 new messages