Hallo Bernd!
Codes in Excel:
Sub CATMain()
Dim CATIA As Object
On Error Resume Next
Set CATIA = GetObject("CATIA.Application")
If Err.Number <> 0 Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
On Error GoTo 0
Set documents1 = CATIA.Documents
Set partDocument1 = documents1.Add("Part")
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item("Hauptkörper")
'---Skizze auf der zx-Ebene---
Set sketches1 = body1.Sketches
Set originElements1 = part1.OriginElements
Set reference1 = originElements1.PlaneZX
Set sketch1 = sketches1.Add(reference1)
part1.InWorkObject = sketch1
'---Skizze bearbeiten
Set factory2D1 = sketch1.OpenEdition()
Set geometricElements1 = sketch1.GeometricElements
Set axis2D1 = geometricElements1.Item("Absolute Achse")
Set line2D1 = axis2D1.GetItem("H-Richtung")
line2D1.ReportName = 1
Set line2D2 = axis2D1.GetItem("V-Richtung")
line2D2.ReportName = 2
'---Rechteck mit 4 Punkten und 4 Linien---
Set point2D1 = factory2D1.CreatePoint(10.996856, 11.459883)
point2D1.ReportName = 3
Set point2D2 = factory2D1.CreatePoint(138.328888, 11.459883)
point2D2.ReportName = 4
Set line2D3 = factory2D1.CreateLine(10.996856, 11.459883, 138.328888, 11.459883)
line2D3.ReportName = 5
line2D3.StartPoint = point2D1
line2D3.EndPoint = point2D2
Set point2D3 = factory2D1.CreatePoint(138.328888, 24.887623)
point2D3.ReportName = 6
Set line2D4 = factory2D1.CreateLine(138.328888, 11.459883, 138.328888, 24.887623)
line2D4.ReportName = 7
line2D4.StartPoint = point2D2
line2D4.EndPoint = point2D3
Set point2D4 = factory2D1.CreatePoint(10.996856, 24.887623)
point2D4.ReportName = 8
Set line2D5 = factory2D1.CreateLine(138.328888, 24.887623, 10.996856, 24.887623)
line2D5.ReportName = 9
line2D5.StartPoint = point2D3
line2D5.EndPoint = point2D4
Set line2D6 = factory2D1.CreateLine(10.996856, 24.887623, 10.996856, 11.459883)
line2D6.ReportName = 10
line2D6.StartPoint = point2D4
line2D6.EndPoint = point2D1
'---Bedingungen so dass die langen Linien horizontal und die kurzen Linien vertikal sind---
Set constraints1 = sketch1.Constraints
Set reference2 = part1.CreateReferenceFromObject(line2D3)
Set reference3 = part1.CreateReferenceFromObject(line2D1)
Set constraint1 = constraints1.AddBiEltCst(catCstTypeHorizontality, reference2, reference3)
constraint1.Mode = catCstModeDrivingDimension
Set reference4 = part1.CreateReferenceFromObject(line2D5)
Set reference5 = part1.CreateReferenceFromObject(line2D1)
Set constraint2 = constraints1.AddBiEltCst(catCstTypeHorizontality, reference4, reference5)
constraint2.Mode = catCstModeDrivingDimension
Set reference6 = part1.CreateReferenceFromObject(line2D4)
Set reference7 = part1.CreateReferenceFromObject(line2D2)
Set constraint3 = constraints1.AddBiEltCst(catCstTypeVerticality, reference6, reference7)
constraint3.Mode = catCstModeDrivingDimension
Set reference8 = part1.CreateReferenceFromObject(line2D6)
Set reference9 = part1.CreateReferenceFromObject(line2D2)
Set constraint4 = constraints1.AddBiEltCst(catCstTypeVerticality, reference8, reference9)
constraint4.Mode = catCstModeDrivingDimension
'---Skizze fertig---
sketch1.CloseEdition
part1.InWorkObject = sketch1
part1.Update
'---Quader---
Set shapeFactory1 = part1.ShapeFactory
Set pad1 = shapeFactory1.AddNewPad(sketch1, 20#)
part1.Update
End Sub
-------------------------------------------------
Es gibt auch kein Problem wenn das Makro in Catia ausgeführt wird. Richtungsproblem nur beim Fall mit Excel.
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP