Ok I have found this macro on the group
I cannot get it to work? What gives? How should it be exectuted? I run it in a part that only has a point cloud in a 3d skectch and nouthing happens... I could save myself hours and hours with this. does anyone have a macro that can take a point cloud in SW and export it to commman delimited or something of that nature?
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 Set exApp = CreateObject("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 = (sp.X * 1000) / 25.4 sheet.Cells(2 + i, 3).Value = (sp.Y * 1000) / 25.4 sheet.Cells(2 + i, 4).Value = (sp.Z * 1000) / 25.4 exApp.Columns.AutoFit End If Next i End If End If End If End If End If End If End Sub
Ben