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.
Reply to
flyboy555
Loading thread data ...
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
Reply to
flyboy555
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.
Reply to
TOP
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
Reply to
flyboy555
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.
Reply to
flyboy555
hmmmm, another interesting quirk is that if the 3d point is constrained to lie on another point in another sketch, the coordinates appear twice.
Reply to
flyboy555
We are going to have to get you into reading help. The line:
Round(sp.x * 1000 / 25.4, DEC)
calls the Round functiRound 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.
Reply to
TOP

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.