Макрос VBA для экспорта сплайнов из CATIA в текстовый файл (.dat)

поэтому мне было интересно, могу ли я получить некоторую помощь здесь. поэтому в основном я пытаюсь выяснить, как написать файл данных, который сможет импортировать сплайны в Catia. Эти сплайны при импорте должны вести себя как сетки на конструкции, то есть отображать сетчатую структуру, но вместо сетки на ней будут сплайны. поэтому прямо сейчас я подумал изучить макрос, который экспортирует несколько сплайнов, которые я создал на структуре, в текстовый (.dat) файл. но у меня были проблемы с макросом, который у меня есть, поскольку он просит меня выбрать сплайн, но не позволяет мне щелкнуть по сплайну в дереве спецификаций. Дело в том, что у меня много сплайнов, и я хотел бы, чтобы макрос просто автоматически выбирал сплайны, не спрашивая, и экспортировал их ..... ПОЖАЛУЙСТА, ПОМОГИТЕ МНЕ. большое спасибо.

Итак, вот код:

   Sub CATMain()

'*** *** Definition Variables
Dim CtrlPoint()
Dim oCoordinates(1)
Dim StartKrit As Integer

'*** Query document type ***
StartKrit = 0
Set oDoc = CATIA.ActiveDocument
ObjType = TypeName(oDoc)
If ObjType = "PartDocument" Then
DocType = "Part"
StartKrit = 1
ElseIf ObjType = "DrawingDocument" Then
DocType = "Drawing "
StartKrit = 1
End If

If StartKrit = 0 Then
box = MsgBox(" The active document is neither a CATPart still CATDrawing! " + Chr(10) + _
" The macro can not continue and will now exit " + Chr(10) + _
"Please select a CATPart or a CATDrawing and start the macro again!", vbCritical + vbOKOnly, "incorrect document type")
Exit Sub
End If


'*** Create the * .txt files ***
StorePath = "C: \"
StoreName = "Splinekoordinaten" & Date
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(StorePath & StoreName & ".txt ") = True Then
box = MsgBox(" file ==> " + StorePath + StoreName + " <== already exists! " + Chr(10) + " Do you want to overwrite the file? ", vbCritical + vbYesNo, "file already exists ")
If box = vbNo Then
box = MsgBox(" The macro is now finished ", vbInformation + vbOKOnly, " the user stops ")
Exit Sub
End If
End If
Set A = fs.CreateTextFile("D:\school\INTERNSHIP\Macro\Newest.txt ", True)
A.WriteLine (" points coordinates of a spline ")
A.WriteLine (" ")
If DocType = " Part " Then
A.WriteLine (" name of CATParts: " & oDoc.Name)
ElseIf DocType = " Drawing " Then
A.WriteLine ("name of CATDrawing:" & oDoc.Name)
End If
A.WriteLine ("")

'*** Readout from the CATDrawing ***
If DocType = "Drawing" Then
Dim otype2D(0)
Dim Selection
Set mysel = oDoc.Selection
mysel.Clear
otype2D(0) = "Spline2D"
mysel.Clear
box = MsgBox(" Please select now the spline ", vbInformation + vbOKCancel, " spline Select ")
If box = vbCancel Then
box = MsgBox(" you have the selection canceled " + Chr(10) + _
" the macro is now finished! ", vbCritical, "abort by user")
If fs.FileExists(StorePath & StoreName & ".txt") = True Then
A.Close
fs.DeleteFile (StorePath & StoreName & ".txt")
End If
Exit Sub
End If
Selection = mysel.SelectElement2(otype2D, "Please select the spline", False)
If Selection = "Normal" Then
oSplineName = mysel.Item(1).Value.Name
Set oSpline = mysel.Item(1).Value
A.WriteLine ("name of the selected spline:" & oSplineName)
A.WriteLine ("")
A.WriteLine ("")
Else
box = MsgBox("you have canceled the selection" + Chr(10) + _
"the macro is now finished! ", vbCritical, " abort by user ")
If fs.FileExists(StorePath & StoreName & " .txt ") = True Then
A.Close
fs.DeleteFile (StorePath & StoreName & " .txt ")
End If
Exit Sub
End If
mysel.Clear

Set QuCtrlP = oSpline.EndPoint
QuCtrlPRaw = QuCtrlP.Name
QuCtrlPSemi = Split(QuCtrlPRaw, ".")
QuCtrlPFin = QuCtrlPSemi(1) - 1
ReDim Preserve CtrlPoint(QuCtrlPFin)
For j = 0 To QuCtrlPFin
Set CtrlPoint(j) = oSpline.GetItem("Ktrl-point." & j + 1)
CtrlPoint(j).GetCoordinates oCoordinates
A.WriteLine ("point" & j + 1 & "X / Y")
A.WriteLine (oCoordinates(0))
A.WriteLine (oCoordinates(1))
A.WriteLine ("")
Next

'*** readout from the CATPart ***
ElseIf DocType = "Part" Then
Dim otype3D(0)
Set mysel = oDoc.Selection
mysel.Clear
otype3D(0) = "Spline2D"
mysel.Clear
box = MsgBox("Please select now the spline", vbInformation + vbOKCancel, "spline Select")
If box = vbCancel Then
box = MsgBox("you have canceled the selection" + Chr(10) + _
"The macro is now finished!", vbCritical, "abort by user")
If fs.FileExists(StorePath & StoreName & ".txt") = True Then
A.Close
fs.DeleteFile (StorePath & StoreName & ".txt ")
End If
Exit Sub
End If
Selection = mysel.SelectElement2(otype3D, " Please select the spline ", False)
If Selection = " Normal " Then
oSplineName = mysel.Item(1).Value.Name
Set oSpline = mysel.Item(1).Value
A.WriteLine ("name of the selected spline:" & oSplineName)
A.WriteLine ("")
A.WriteLine ("")
Else
box = MsgBox("you have canceled the selection" + Chr(10) + _
"The macro is now finished!", vbCritical, "abort by user")
If fs.FileExists(StorePath & StoreName & ".txt") = True Then
A.Close
fs.DeleteFile (StorePath & StoreName & " .txt ")
End If
Exit Sub
End If

mysel.Clear
Set QuCtrlP = oSpline.EndPoint
QuCtrlPRaw = QuCtrlP.Name
QuCtrlPSemi = Split(QuCtrlPRaw, " ")
QuCtrlPFin = QuCtrlPSemi(1) - 1
ReDim Preserve CtrlPoint(QuCtrlPFin)
For j = 0 To QuCtrlPFin
Set CtrlPoint(j) = oSpline.GetItem("Ktrl-point." & j + 1)
CtrlPoint(j).GetCoordinates oCoordinates
A.WriteLine ("point" & j + 1 & "X / Y")
A.WriteLine (oCoordinates(0))
A.WriteLine (oCoordinates(1))
A.WriteLine ("")
Next
End If

'**** Issue Storage Location ****
Ml = "The macro has completed successfully"
M2 = "The * .txt file is saved under the following path:"
M2_ZU_1 = "==>"
M2_ZU_2 = "<== "
M3 = " Are you in the path now oeffnen? "
Title = "memory data"
skin = vbInformation + vbYesNo
query = MsgBox(Ml + Chr(10) + Chr(10) + M2 + Chr(10) + Chr(10) + M2_ZU_1 + StorePath + StoreName + M2_ZU_2 + Chr(10) + Chr(10) + M3, skin, Title)

If query = vbYes Then
ExplorerPath = "C: \ WINDOWS \ explorer.exe"
Explorer = CATIA.SystemService.ExecuteProcessus(ExplorerPath & "" & StorePath)
End If


End Sub

person Hadiza Hamza    schedule 15.12.2016    source источник


Ответы (1)


Ваш фильтр selectelement2 настроен на сплайн2D, вы выбрали сплайны эскиза или 3D-сплайны?

Если вы работаете с 3D-сплайнами, как это звучит, вы хотите использовать этот код:

mysel.Clear
otype3D(0) = "HybridShapeSpline"
mysel.Clear
box = MsgBox("Please select now the spline", vbInformation + vbOKCancel, "spline Select")
If box = vbCancel Then
box = MsgBox("you have canceled the selection" + Chr(10) + _
"The macro is now finished!", vbCritical, "abort by user")
If fs.FileExists(StorePath & StoreName & ".txt") = True Then
A.Close
fs.DeleteFile (StorePath & StoreName & ".txt ")
End If
Exit Sub
End If
Selection = mysel.SelectElement2(otype3D, " Please select the spline ", False)

Дополнительную помощь вы найдете на сайте www.coe.org, там есть значительная группа автоматизаторов CATIA.

person Eric    schedule 20.12.2016