Сохранение эскиза кривой SolidWorks в формате *.dat или *.txt

[basilica 0]

Кривую в SolidWorks можно построить используя ее описание заданное файлами *.dat или *.txt.

А как выполнить обратную задачу - имея эскиз кривой описать ее в файле *.dat или *.txt ?

[SERoz 201]

А как выполнить обратную задачу - имея эскиз кривой описать ее в файле *.dat или *.txt ?

Нечто подобное (сохранить точки кривой в файл) делаю с помощь макроса...

Вот текст (создать макрос и вставить туда КОД):

Скрытый текст: точки кривой в файл Экселя

Макрос для получения координат (XYZ) вершин (точек) кривых эскиза и записи в таблицу Экселя...

работает как на 3D так и на 2D эскизах.

Код

==============

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, 5).Value = "Job Number"

sheet.Cells(1, 6).Value = "=NOW()"

sheet.Cells(2, 2).Value = "X"

sheet.Cells(2, 3).Value = "Y"

sheet.Cells(2, 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(3 + i, 1).Value = "Pt. " & i + 1

sheet.Cells(3 + i, 2).Value = Round(sp.X * 1000 / 1, 3)

sheet.Cells(3 + i, 3).Value = Round(sp.Y * 1000 / 1, 3)

sheet.Cells(3 + i, 4).Value = Round(sp.Z * 1000 / 1, 3)

exApp.Columns.AutoFit

End If

Next i

End If

End If

End If

End If

End If

End If

End Sub

=========================

В библиотеках не забыть подключить Microsoft Excel Object library

Есть ограничения:

Цитата

' Create a 3dSketch in that part file

' 3d skecth cannot have any coincident relations to other points or else there will be double coordinates in the table

' Select that 3dsketch and run macro

' Modify excel file with appropriate format and additional text and save

' File can now be inserted into Solidworks drawing file

------------------

"Создать 3dSketch в том, что <br> часть файла '3d skecth не может иметь никакого отношения совпадают с другими точками или иначе будет двойной координаты в таблице <br>" Выберите, что 3dsketch и запустить макрос <br>' Изменить Excel файл с соответствующий формат и дополнительный текст и сохранить файл, <br> теперь могут быть вставлены в файл чертежа Solidworks

Макрос работает ТОЛЬКО с эскизом (в модели), т.е. выделить строку эскиза (никуда входить не надо) и жмакнуть по кнопке макроса...

В Экселе можно отредактировать полученную таблицу координат (удалить лишнее или дописать нужное)...