Hallo,
wir haben bei uns häufig das Problem, dass wir Kaufteil-Modelle für unsere Konstruktionen benötigen, die wir als z.B. step von den Internetseiten der Lieferanten downloaden.
Diese Modelle haben in der Regel keine Masseinformationen hinterlegt.
Ein Material aus der Standardbibliothek zu verwenden macht oftmals auch keinen Sinn, weil dann die Masse (gemessen in CATIA) mit der laut Datenblatt des Herstellers meistens nicht übereinstimmt.
Also haben wir uns immer so geholfen, dass wir die Modelle mit Density=1000 gemessen haben und über den Dreisatz dann die entsprechend einzutragende Density ermittelt haben, um auf die Masse laut Datenblatt zu kommen.
Das Materialfeature haben wir dann immer in "TEMP" umbenannt.
Jetzt habe ich ein Makro gebastelt, wo ich in einer Inputbox die Sollmasse eingeben kann und dem Part dann die entprechende Density zugeordnet wird.
Das funktioniert auch wunderbar, nur leider habe ich noch keinen Weg gefunden, wie ich im Makro den Namen des Features gleich mit umbenennen kann. Das muss ich jetzt nachträglich immer noch händisch machen.
Das Makro vergibt erst ein Material aus der Materialbibliothek (hier Aluminium) und ändert dann den Wert für Density im Part:
Sub CATMain()
Dim PartDoc As PartDocument
Dim part1 As Part
Dim Mat As Material
Dim oAnalysisMat As AnalysisMaterial
Dim sInput As String
Dim dMasse As Double
Dim dMassOrigin As Double
Dim iMerkInput As Integer
'pruefen, ob ein CATPart oder CATProduct geoeffnet ist
On Error Resume Next
Set PartDoc = CATIA.ActiveDocument
On Error GoTo 0
If TypeName(PartDoc) = "PartDocument" Then
Set part1 = PartDoc.Part
Else
MsgBox "NO CATPart or CATProduct opened!" & vbCrLf & "Es ist KEIN CATPart oder CATProduct geoeffnet!" & vbCrLf & vbCrLf & "Please open a CATPart or CATProduct." & vbCrLf & "Bitte oeffnen Sie ein CATPart oder CATProduct.", vbCritical, "Error/ Fehler"
Exit Sub
End If
'Eingabe der Sollmasse in [kg]
Do
iMerkInput = 0
sInput = Replace(Trim(InputBox("Please insert the mass of the part [kg]:" & vbCrLf & "Bitte die Masse des Teils eingebe [kg]:", "Input mass/ Masse eingeben", 1)), ".", ",")
If sInput = "" Then
MsgBox "User abort!" & vbCrLf & "Abbruch durch Benutzer!", vbExclamation, "Abort/ Abbruch"
Exit Sub
ElseIf IsNumeric(sInput) = False Then
MsgBox "Please insert numeric value for mass!" & vbCrLf & "Bitte numerischen Wert fuer die Masse eingeben!", vbExclamation, "Error/ Fehler"
Else
iMerkInput = 1
End If
Loop Until iMerkInput = 1
dMasse = sInput
'Materialkatalog öffnen und Material vergeben (hier Aluminium, nur zur Hilfe, weil Material vergeben sein muss, sonst kann es nicht geändert werden)
Dim sDocPath As String
Dim sFilePath As String
Dim oMaterial_document As Document
Dim oManager As MaterialManager
sDocPath = CATIA.SystemService.Environ("CATDocView")
sFilePath = CATIA.FileSystem.ConcatenatePaths(sDocPath, "English\online\CAAScdMatUseCases\samples\MyCatalog.CATMaterial")
Set oMaterial_document = CATIA.Documents.Open(sFilePath)
Set oMaterial_document = CATIA.ActiveDocument
Set oManager = part1.GetItem("CATMatManagerVBExt")
Set Mat = oMaterial_document.Families.Item(2).Materials.Item(1)
oManager.ApplyMaterialOnPart part1, Mat, 0
oMaterial_document.Close
'zur Werteermittlung erstmal Dichte 1000 vergeben
Dim Params As Parameters
Dim Param As parameter
Set Params = part1.Parameters
'Set Param = Nothing
'Set Param = Params.Item("Feature Name")
'Param.Value = "TEMP"
Set Param = Nothing
Set Param = Params.Item("Density")
Param.Value = 1000
Set Param = Nothing
'Masse des Parts mit Dichte 1000 ermitteln als Referenz für die ermittlung der Solldichte
Dim oInertia As AnyObject
Dim oProduct As AnyObject
Set oProduct = PartDoc.Product
Set oInertia = oProduct.GetTechnologicalObject("Inertia")
dMassOrigin = oInertia.Mass
'Solldichte ermitteln und einsetzen
Set Param = Params.Item("Density")
Param.Value = (dMasse / dMassOrigin) * 1000
Set Param = Nothing
part1.Update
End Sub
Kann ich die Umbenennung im Makro mit integrieren.
Oder kann ich auch ein komplett neues Material mit eigener Benennung und Density im Part über Makro erzeugen?
Schonmal Danke für die Antworten!
------------------
Grüß Dich Meiner!
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP