Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations IDS on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro for reading point locations 2

Status
Not open for further replies.

APPENG

Mechanical
Jan 22, 2002
366
Does anyone have a macro laying around that would query the xyz coordinates of points in a 3d sketch and save them to a .txt or .csv file?

If you do I surely would appreciate a copy!



Regards,
Jon
jgbena@yahoo.com
 
Replies continue below

Recommended for you

I have the opposite, points from XYZ. Maybe you could (literally) reverse engineer it?

[bat]Someday, someone may kill you with your own gun, but they should have to beat you to death with it because it is empty.[bat]
 
Thanks for the offer but i figured it out! In case anyone is intersted, here is the source code. caution this program reads the points in order of creation so you may need to rearrange your data in excel if they are out of order!

instructions:
select the sketch that you wish to "read" and run the macro.
the macro will bring up excel and start filling the sheet with xyz point data.

Sub main()
Dim swApp As SldWorks.SldWorks
Dim doc As SldWorks.ModelDoc2
Dim part As SldWorks.PartDoc
Dim sm As SldWorks.SelectionMgr
Dim feat As SldWorks.feature
Dim sketch As SldWorks.sketch
Dim v As Variant
Dim i As Long
Dim sseg As SldWorks.SketchSegment
Dim sline As SldWorks.SketchLine
Dim sp As SldWorks.SketchPoint
Dim ep As SldWorks.SketchPoint
Dim s As String

Dim exApp As Excel.Application
Dim sheet As Excel.Worksheet

Set exApp = New Excel.Application
If Not exApp Is Nothing Then
exApp.Visible = True
If Not exApp Is Nothing Then
exApp.Workbooks.Add
Set sheet = exApp.ActiveSheet
If Not sheet Is Nothing Then
sheet.Cells(1, 2).Value = "X"
sheet.Cells(1, 3).Value = "Y"
sheet.Cells(1, 4).Value = "Z"
End If
End If
End If

Set swApp = GetObject(, "sldworks.application")
If Not swApp Is Nothing Then
Set doc = swApp.ActiveDoc
If Not doc Is Nothing Then
If doc.GetType = swDocPART Then
Set part = doc
Set sm = doc.SelectionManager
If Not part Is Nothing And Not sm Is Nothing Then
If sm.GetSelectedObjectType2(1) = swSelSKETCHES Then
Set feat = sm.GetSelectedObject4(1)
Set sketch = feat.GetSpecificFeature
If Not sketch Is Nothing Then
v = sketch.GetSketchPoints
For i = LBound(v) To UBound(v)
Set sp = v(i)
If Not sp Is Nothing And Not sheet Is Nothing And Not exApp Is Nothing Then
'sheet.Cells(2 + i, 1).Value = "Normal Vector " & i + 1
sheet.Cells(2 + i, 2).Value = Round(sp.x * 1000 / 25.4, DEC)
sheet.Cells(2 + i, 3).Value = Round(sp.y * 1000 / 25.4, DEC)
sheet.Cells(2 + i, 4).Value = Round(sp.z * 1000 / 25.4, DEC)
exApp.Columns.AutoFit
End If
Next i
End If
End If
End If
End If
End If
End If
End Sub


Regards,
Jon
jgbena@yahoo.com
 
Tick,

Would you mind posting your macro on the FAQ section. I have a spreedsheet that spits out x & y points for gerotor geometry and want to read it into SWx. My current MCAD program is Pro/e but I want to hone my SWx skills thks


"Never underestimate the power of very stupid people in large groups." John Kenneth Galbraith
 
For metric users (using mm) change

sheet.Cells(2 + i, 2).Value = Round(sp.x * 1000 / 25.4, DEC)
.....

by

sheet.Cells(2 + i, 2).Value = sp.x * 1000
.....

Regards
 
Ahh good point Mac...

And thanks Scott ;)



Regards,
Jon
jgbena@yahoo.com
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor