3D Sketch Points to Excel

Feb 21, 2006 7 Replies

has anyone gotten the old macro from APPENG (July 2005) to work? I tried it, but it wouldn't compile. Thanks.



here's the link

formatting link
i wrote the guys over there, but didn't get a response. it seems to hang up when it gets to the line

"Dim exApp As Excel.Application"

but since this is my first macro, i'm wondering if i'm doing something wrong. thanks again.

here's the macro

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

Works fine for me. There is one thing you have to do. When you see a line like:

Dim exApp As Excel.Application

You have to load the type library for that application. In the macro editor menu, TOOLS/REFERENCES find MicroSoft Excel type or object library and checkmark it. Then run the macro.

top,

i owe you one (food, beer, or airplane ride) for the excel object tip!

(i'm designing an airplane at home. i have a legal seat, but i didn't pay for any maintenance or training. the vars reading this are probably going nuts....)

the macro now runs, but the dimensions i'm using are all rounded to the nearest inch. i'm going to try deleting the "Round" words above and see what happens.

flyboy steve

nope, deleting the "Round" gave me a compile error.

ok top, for another bribe, do you have any idea how to correct this? i already checked the spreadsheet; the default format is 2 decimal places.

hmmmm, another interesting quirk is that if the 3d point is constrained to lie on another point in another sketch, the coordinates appear twice.

We are going to have to get you into reading help. The line:

Round(sp.x * 1000 / 25.4, DEC)

calls the Round functi Round Function

Description

Returns a number rounded to a specified number of decimal places.

Syntax

Round(expression [,numdecimalplaces])

Since DEC is not a declared variable that I can see, the default behaviour is to round to an integer which would be your inches. Add a line like

DEC = 3 prior to the lines which use ROUND and you should get 3 decimal places.

Join the Discussion

Have something to add? Share your thoughts — no account required.

Didn't find your answer?

Ask the community — no account required