3D Sketch Points to Excel

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

 

Can you post it?

 

here's the link
http://www.eng-tips.com/faqs.cfm?fid=1040

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 function in VB, not Excel. The help for this says:

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.