Hallo liebes Forumsmitglieder,
ich konnte mir mit Hilfe des Makrorecorders und dem Forum hier mein Makro zum laufen bringen. Dabei zeichnete der Makrorekorder leider zu viel, bzw. überflüssige Dinge auf. An einigen Stelle konnte ich herausfinden wie ich mein Programm verkürzen/vereinfachen kann, aber leider nicht überall.
Meine Frage ist daher welche Teile vom Code kann ich noch weiter zusammenfassen oder durch andere Befehle vereinfachen?
Für Hinweise und Tipps wäre ich sehr dankbar.
Hier ist mein Code wie er aktuell funktioniert:
Ein anderer Teil meines Codes importiert mir XYZ-Punkte aus einer Exceltabelle und verbindet diese zu mehrern Splines. Das folgende Makro verbindet diese Splines und erzeugt eine Geometrie, die dem Spline folgt. Zum Schluss wird das erzeugte Volumen Modell von einen bereits vorhandnen Part (Trommel) abgezugen.
'Registering CATIA Libraries http://www.scripting4v5.com/additional-articles/registering-catia-libraries/
'1. Splines miteinander verbinden
'2. Ebene erzeugen
'3. Geometrie Ellipse Ebene
'4. Sweep von Ellipsengeometrie dem Spline folgen lassen
'5. Seil als Volumenmodell
'6. Boolische Operation Trommel minus Seil
Public Sub Join_Spline()
'Dimensionierung der Variablen
Dim CATIA As Object
Set CATIA = GetObject(, "CATIA.Application")
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("GeometryFromExcel")
Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes
'Anzahl der Splines bestimmen
Dim selection1 As Selection
Set selection1 = CATIA.ActiveDocument.Selection
'selection1.Search "Name=Spline*,all"
selection1.Search "((((CATStFreeStyleSearch.GSMCurve + CAT2DLSearch.2DSplineCurve) + CATSketchSearch.2DSplineCurve) + CATDrwSearch.2DSplineCurve) + CATGmoSearch.GSMCurve),all"
anzahlspline = selection1.Count
'MsgBox anzahlspline
Dim i As Integer
'----------------------------
Dim hybridShapeSpline1 As HybridShape
Set hybridShapeSpline1 = hybridShapes1.Item("Spline.1")
Dim ref1 As Reference
Set ref1 = part1.CreateReferenceFromObject(hybridShapeSpline1)
Dim hybridShapeSpline2 As HybridShape
Set hybridShapeSpline2 = hybridShapes1.Item("Spline.2")
Dim ref2 As Reference
Set ref2 = part1.CreateReferenceFromObject(hybridShapeSpline2)
Dim hybridShapeAssemble1 As HybridShapeAssemble
Set hybridShapeAssemble1 = hybridShapeFactory1.AddNewJoin(ref1, ref2)
'Spline3-6 erzeugen und verbinden
'--------
'!!!!!!!!
' "object" als wort im folgenden ersetzen durch was anderes
For i = 3 To selection1.Count
Set obj = selection1.Item(i).Value 'Auswahl der Spline.i im Geometrischem Set "Geometrie von Excel
'MsgBox object.Name ' gibt den Instanznamen aus
Dim hybridShapeSplinei As HybridShape
Set hybridShapeSplinei = hybridShapes1.Item(obj.Name) 'Auswahl des Splines der hinzugefügt werden soll
'MsgBox hybridShapes1.Item(object.Name).Name
Dim ref3 As Reference
Set ref3 = part1.CreateReferenceFromObject(hybridShapeSplinei) ' REferenz wird generiert
hybridShapeAssemble1.AddElement ref3 'Spline wir hinzugefügt
Next
'-----------------------------------------------------
'Eigenschaften Join Befehl
hybridShapeAssemble1.SetConnex 1
hybridShapeAssemble1.SetManifold 1
hybridShapeAssemble1.SetSimplify 0
hybridShapeAssemble1.SetSuppressMode 0
hybridShapeAssemble1.SetDeviation 0.001
hybridShapeAssemble1.SetAngularToleranceMode 0
hybridShapeAssemble1.SetAngularTolerance 0.5
hybridShapeAssemble1.SetFederationPropagation 0
'------------------------------------------------------
hybridBody1.AppendHybridShape hybridShapeAssemble1
part1.InWorkObject = hybridShapeAssemble1
part1.Update
'_________________________________________________________________________
'2.Ebene an Point1 erstellen
'Dient als skizzen Ebene für den Querschnittt der Geometrie
Dim hybridShapeAssemble2 As HybridShape
Set hybridShapeAssemble2 = hybridShapes1.Item("Join.1")
Dim ref4 As Reference
Set ref4 = part1.CreateReferenceFromObject(hybridShapeAssemble2)
Dim hybridShapePointCoord1 As HybridShape
Set hybridShapePointCoord1 = hybridShapes1.Item("Point.1")
Dim ref5 As Reference
Set ref5 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(ref4, ref5)
hybridBody1.AppendHybridShape hybridShapePlaneNormal1
part1.InWorkObject = hybridShapePlaneNormal1
part1.Update
'Create Geometry of the ellipse on Plane.1 = Skizze
Dim sketches1 As Sketches
Set sketches1 = hybridBody1.HybridSketches
Dim ref6 As HybridShape
Set ref6 = hybridShapes1.Item("Plane.1")
Dim sketch1 As Sketch
Set sketch1 = sketches1.Add(ref6)
part1.InWorkObject = sketch1
Dim factory2D1 As Factory2D
Set factory2D1 = sketch1.OpenEdition()
A = Range("a").Value 'X Richtung = V = R2
B = Range("b").Value 'Y Richtung = H = R1
'MsgBox A & vbLf & B
Dim ellipse2D1 As Ellipse2D
Set ellipse2D1 = factory2D1.CreateClosedEllipse(0#, 0#, 0#, 0#, B, A) '(X,Y,DX1,DY1,R1,R2)
sketch1.CloseEdition
part1.InWorkObject = hybridBody1
part1.Update
' Sweep Seilhülle generieren
Set sketch2 = sketches1.Item("Sketch.2")
Dim ref7 As Reference
Set ref7 = part1.CreateReferenceFromObject(sketch2)
'Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes
'Dim hybridShapeAssemble1 As HybridShape
Set hybridShapeAssemble1 = hybridShapes1.Item("Join.1")
Dim ref8 As Reference
Set ref8 = part1.CreateReferenceFromObject(hybridShapeAssemble1)
Dim hybridShapeSweepExplicit1 As HybridShapeSweepExplicit
Set hybridShapeSweepExplicit1 = hybridShapeFactory1.AddNewSweepExplicit(ref7, ref8)
hybridShapeSweepExplicit1.SubType = 1
Dim originElements1 As OriginElements
Set originElements1 = part1.OriginElements
Dim hybridShapePlaneExplicit1 As AnyObject
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Dim ref9 As Reference
Set ref9 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
hybridShapeSweepExplicit1.Reference = ref9
hybridShapeSweepExplicit1.SetAngleRef 1, 0#
hybridShapeSweepExplicit1.SolutionNo = 0
hybridShapeSweepExplicit1.SmoothActivity = False
hybridShapeSweepExplicit1.GuideDeviationActivity = False
hybridShapeSweepExplicit1.SetbackValue = 0.02
hybridShapeSweepExplicit1.FillTwistedAreas = 1
hybridBody1.AppendHybridShape hybridShapeSweepExplicit1
part1.InWorkObject = hybridShapeSweepExplicit1
part1.Update
'Volumenmodell aus sweep erstellen
'Dim part1 As Part
'Set part1 = partDocument1.Part
Dim bodies1 As Bodies
Set bodies1 = part1.Bodies
Dim body1 As Body
Set body1 = bodies1.Item("Seil")
part1.InWorkObject = body1
Dim shapeFactory1 As Factory
Set shapeFactory1 = part1.ShapeFactory
Dim ref10 As Reference
Set ref10 = part1.CreateReferenceFromName("")
Dim closeSurface1 As CloseSurface
Set closeSurface1 = shapeFactory1.AddNewCloseSurface(ref10)
'Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
'Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("GeometryFromExcel")
'Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes
'Dim hybridShapeSweepExplicit1 As HybridShape
Set hybridShapeSweepExplicit1 = hybridShapes1.Item("Sweep.1")
Dim ref11 As Reference
Set ref11 = part1.CreateReferenceFromObject(hybridShapeSweepExplicit1)
closeSurface1.Surface = ref11
part1.Update
''Boolische Operation Trommel minus Seil
Set part1 = partDocument1.Part
'Dim bodies1 As Bodies
Set bodies1 = part1.Bodies
Dim body2 As Body
Set body2 = bodies1.Item("Trommel")
part1.InWorkObject = body2
'Dim shapeFactory1 As Factory
Set shapeFactory1 = part1.ShapeFactory
Dim body3 As Body
Set body3 = bodies1.Item("Seil")
Dim remove1 As Remove
Set remove1 = shapeFactory1.AddNewRemove(body3)
part1.Update
'Dim selection1 As Selection
Set selection1 = partDocument1.Selection
Dim visPropertySet1 As VisPropertySet
Set visPropertySet1 = selection1.VisProperties
'Dim part1 As Part
Set part1 = partDocument1.Part
'Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
'Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("GeometryFromExcel")
Set hybridBodies1 = hybridBody1.Parent
Dim bSTR1 As String
bSTR1 = hybridBody1.Name
selection1.Add hybridBody1
Set visPropertySet1 = visPropertySet1.Parent
Dim bSTR2 As String
bSTR2 = visPropertySet1.Name
Dim bSTR3 As String
bSTR3 = visPropertySet1.Name
visPropertySet1.SetShow 1
selection1.Clear
'-----------------------------------
'NEW 21.10.16
'Catia File speichern unter
Dim Datei, strFilePath As String
Set Datei = CATIA.ActiveDocument
Fehler:
strFilePath = CATIA.FileSelectionBox("SaveAs", "*.CATPart", 1)
'If user clicked cancel (empty string is returned), then exit the program
If strFilePath = "" Then
Exit Sub
ElseIf Dir(strFilePath) <> "" Then
MsgBox "Datei ist noch geöffnet"
GoTo Fehler:
Else
Datei.SaveAs strFilePath
End If
'----------------------------------
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP