Code:
Sub xStart()
Dim body_sel As Selection
Dim dbody_sel
Dim InputObjectType(0) As Variant
Dim partDoc As Part
InputObjectType(0) = "Body"
Dim Status
Dim masa_poj As Double
Dim obj_poj As Double
Dim masa As Double
Dim objetosc As Double
Set partDoc = CATIA.ActiveDocument.Part
Set body_sel = CATIA.ActiveDocument.Selection
Set dbody_sel = body_sel
Dim dbody As Body
Dim inertia As inertia
Dim inercje As Inertias
Dim curr_body As Body
Dim main_body As Body
Dim test_body As Body
Dim body_col As New VBA.Collection
Dim shapeFactory1 As ShapeFactory
Set shapeFactory1 = partDoc.ShapeFactory
Dim mat As ParameterSet main_body = partDoc.Bodies.Item("Funktionsteil")
partDoc.InWorkObject = main_body
partDoc.Update
body_sel.Search ("((((FreeStyle.Body + 'Part Design'.Body) + 'Generative Shape Design'.Body) + 'Functional Molded Part'.Body) + 'Functional Molded Part'.Body) - Name=PartBody;all")
If (Status = "Cancel") Then Exit Sub
masa = 0
objetosc = 0
Dim objSPAWkb As Workbench
Set objSPAWkb = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
Dim objRef As Reference
Dim objMeasurable As Measurable
For i = 1 To body_sel.Count
Set curr_body = body_sel.Item2(i).Value
If InStr(1, curr_body.Name, "GEOEFFNETE") = 0 Then
If curr_body.InBooleanOperation = False Then
If curr_body.Shapes.Count <> 0 Then
body_col.Add curr_body
End If
End If
End If
Next
For j = 1 To body_col.Count
Set curr_body = body_col.Item(j)
Set objRef = partDoc.CreateReferenceFromObject(curr_body)
Set objMeasurable = objSPAWkb.GetMeasurable(objRef)
'Set inertia = inercje.Add(dbody_sel.Item2(i).Value)
Set inertia = GetBodyInertia(partDoc, curr_body)
masa_poj = inertia.Mass '.Value
'inercje.Remove (dbody_sel.Item2(i).Value)
obj_poj = objMeasurable.Volume
masa = masa + masa_poj
objetosc = objetosc + obj_poj
shapeFactory1.AddNewAssemble curr_body
Next
gestosc = masa / objetosc
partDoc.InWorkObject = main_body
partDoc.Update
'--------------------------------------------------------------------------------------------------------------
Dim MaterialDocPath As String
Dim MaterialName As String, MaterialFamilyName As String
' Identify which Material you want:
'*********************************************
MaterialName = "MISCHDICHTE" '*
MaterialFamilyName = "No Material" '*
'*********************************************.
' Identify the Material Doc Path:
'*****************************************************************
MaterialDocPath = "I:\01\01\Catalog_with_no_material.CATMaterial" '*
'*****************************************************************
' Modified From the AutomationV5.chm File:
Dim oMaterial_document As Document
Set oMaterial_document = CATIA.Documents.Read(MaterialDocPath)
Dim oMaterial As Material
Set oMaterial = oMaterial_document.Families.Item(MaterialFamilyName).Materials.Item(MaterialName)
oMaterial.AnalysisMaterial.PutValue "SAMDensity", gestosc & "kg_m3"
Set oManager = partDoc.GetItem("CATMatManagerVBExt")
LinkMode = 0
Set main_body = partDoc.Bodies.Item("PartBody")
oManager.ApplyMaterialOnBody main_body, oMaterial, LinkMode
End Sub
Function GetBodyInertia(ByRef iPart As Part, ByRef iBody As Body) As inertia
'If successful, this function will return an inertia object
Dim objSPAWorkbench As Workbench
Dim objInertia As inertia
On Error Resume Next
Set objSPAWorkbench = iPart.Parent.GetWorkbench("SPAWorkbench")
Set objInertia = objSPAWorkbench.Inertias.Add(iBody)
If Err.Number = 0 Then
Set GetBodyInertia = objInertia
Else
Set GetBodyInertia = Nothing
End If
End Function
Foren auf CAD.de (alle Foren)
| 
