Hallo billisk,
du musst die Richtung auch als Hybridshapedirection definieren, nicht nur als Reference einer Ebene, dann gehts:
Sub CATMain()
'Neues CATPart öffnen
Dim D1 As document
Set D1 = CATIA.Documents.Add("Part")
Dim Bauteil As Part
Set Bauteil = CATIA.ActiveDocument.Part
Dim Product As Product
Set Product = CATIA.ActiveDocument.Product
Product.PartNumber = "Testbauteil"
Product.Revision = "PRJA"
Product.Definition = "TestModel"
Product.Nomenclature = "T001"
'3D Werkzeugkasten deklarieren
Dim Wzk3D As Factory
Set Wzk3D = Bauteil.HybridShapeFactory
'GeoSets erzeugen
Dim GeoSet1 As HybridBody
Set GeoSet1 = Bauteil.HybridBodies.Add
'Punkte erzeugen
Dim P1, P2, P3, P4 As HybridShapePointCoord
Set P1 = Wzk3D.AddNewPointCoord(0, 0, 0)
Set P2 = Wzk3D.AddNewPointCoord(100, 0, 0)
Set P3 = Wzk3D.AddNewPointCoord(100, 100, 0)
Set P4 = Wzk3D.AddNewPointCoord(0, 100, 0)
Dim RefP1, RefP2, RefP3, RefP4 As Reference
Set RefP1 = Bauteil.CreateReferenceFromObject(P1)
Set RefP2 = Bauteil.CreateReferenceFromObject(P2)
Set RefP3 = Bauteil.CreateReferenceFromObject(P3)
Set RefP4 = Bauteil.CreateReferenceFromObject(P4)
'Punkte dem GeoSet zuweissen
GeoSet1.AppendHybridShape P1
GeoSet1.AppendHybridShape P2
GeoSet1.AppendHybridShape P3
GeoSet1.AppendHybridShape P4
'Linien erzeugen
Dim L1, L2, L3, L4 As HybridShapeLinePtPt
Set L1 = Wzk3D.AddNewLinePtPt(RefP1, RefP2)
Set L2 = Wzk3D.AddNewLinePtPt(RefP2, RefP3)
Set L3 = Wzk3D.AddNewLinePtPt(RefP3, RefP4)
Set L4 = Wzk3D.AddNewLinePtPt(RefP4, RefP1)
Dim RefL1, RefL2, RefL3, RefL4 As Reference
Set RefL1 = Bauteil.CreateReferenceFromObject(L1)
Set RefL2 = Bauteil.CreateReferenceFromObject(L2)
Set RefL3 = Bauteil.CreateReferenceFromObject(L3)
Set RefL4 = Bauteil.CreateReferenceFromObject(L4)
'Linien dem GeoSet zuweissen
GeoSet1.AppendHybridShape L1
GeoSet1.AppendHybridShape L2
GeoSet1.AppendHybridShape L3
GeoSet1.AppendHybridShape L4
'Linien Füllen
Dim Fuellen As HybridShapeFill
Set Fuellen = Wzk3D.AddNewFill
Fuellen.AddBound RefL1
Fuellen.AddBound RefL2
Fuellen.AddBound RefL3
Fuellen.AddBound RefL4
Dim RefFuellen As Reference
Set RefFuellen = Bauteil.CreateReferenceFromObject(Fuellen)
'Fuellung dem GeoSet2 zuweissen
GeoSet1.AppendHybridShape Fuellen
'Offset ebene erstellen
Dim Offset1 As HybridShapeOffset
Set Offset1 = Wzk3D.AddNewOffset(RefFuellen, 20, True, 0.01)
'Offsetflaeche dem GeoSet zuweissen
GeoSet1.AppendHybridShape Offset1
'Querschnittlinie der flaäche 1 erstellen
Dim QLine As HybridShapeLinePtPt
Set QLine = Wzk3D.AddNewLinePtPt(RefP1, RefP3)
Dim RefQLine As Reference
Set RefQLine = Bauteil.CreateReferenceFromObject(QLine)
'Ebene deklarieren
Dim EbeneYZ As AnyObject
Set EbeneYZ = Bauteil.OriginElements.PlaneYZ
Dim RefEb As Reference
Set RefEb = Bauteil.CreateReferenceFromObject(EbeneYZ)
'QLine dem GeoSet1zuweissen
GeoSet1.AppendHybridShape QLine
'Extrudefläche aus QLine erzeugen
'________________________________________________________________________________
'Ergaenzung:
'________________________________________________________________________________
Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = Wzk3D.AddNewDirection(RefEb)
'________________________________________________________________________________
Dim Extrude1 As HybridShapeExtrude
'________________________________________________________________________________
'Aenderung RefDirection:
'________________________________________________________________________________
Set Extrude1 = Wzk3D.AddNewExtrude(RefQLine, 100, 100, hybridShapeDirection1)
'________________________________________________________________________________
'ExtrudeFläche dem GeoSet zuweissen
GeoSet1.AppendHybridShape Extrude1
Bauteil.Update
End Sub
------------------
Grüße aus dem Thurgau
Thomas
+++++++++++++++++++++++++++++++++
CATIA - eine Laune der Natur ...
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP