---

Hallo,

das hier ist ein Makro um einfach nur eine Linie aus 2 Punkten (*Pt1 und *Pt2) zu erzeugen. Da ich 5001 solcher Punkte habe (durchnummeriert in einem Geom. Set) würde ich gerne 5000 Linien mit dem Makro erzeugen, dh. es müsste eine Schleife her die den Punktenamen etc immer um eins erhöht. Also Linie2 aus *Pt2 und *Pt3, Linie3 aus *Pt3 und *Pt4...

Leider hab ich keine VBA Kenntnisse. Weiss jemand vielleicht wie man solch eine Schleife programmiert?

Danke vorab,
Cornelius

Language="VBSCRIPT"

Sub CATMain()

Set partDocument1 = CATIA.ActiveDocument

Set part1 = partDocument1.Part

Set hybridShapeFactory1 = part1.HybridShapeFactory

Set parameters1 = part1.Parameters

Set hybridShapePointExplicit1 = parameters1.Item("Point.1 ( *PT1 - wsp *MASTER -  )")

Set reference1 = part1.CreateReferenceFromObject(hybridShapePointExplicit1)

Set parameters2 = part1.Parameters

Set hybridShapePointExplicit2 = parameters2.Item("Point.2 ( *PT2 - wsp *MASTER -  )")

Set reference2 = part1.CreateReferenceFromObject(hybridShapePointExplicit2)

Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2)

Set hybridBodies1 = part1.HybridBodies

Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")

hybridBody1.AppendHybridShape hybridShapeLinePtPt1

part1.InWorkObject = hybridShapeLinePtPt1

part1.Update

End Sub

------------------
Wenn etwas nicht klappt probier ich einfach was anderes - vielleicht klappt das auch nicht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

hmmm, du hattest doch schon mal diese Frage hier gestellt...   

hättest ruhig darauf anworten können, als Feedback für den Anwortenden... anstatt hier nochmals zu Fragen...

im Umkehrschluss einer solchen Community, antwortet der Ratgebende dann einfach nimmer,
da er sein Posting gleich in die Tonne kippen kann. Sic!

codeschnipsel - den oben weiterverwiesen code, um das was ich in deinen Code sehe, angepasst -ungetestet-

Code:

---

Anzahl = mySelection.Count
        For i = 1 To Anzahl Step 2
            Set APt = mySelection.Item(i).Value
            Set EPt = mySelection.Item(i+1).Value
            Set myhybridShapeFactory = myPart.HybridShapeFactory
            Set myhybridShapeLinePtPt = myhybridShapeFactory.AddNewLinePtPt(APt, EPt)
            myhybridBody.AppendHybridShape hybridShapeLinePtPt
            myPart.InWorkObject = hybridShapeLinePtPt
        Next

---

[Diese Nachricht wurde von Thomas Harmening am 24. Apr. 2007 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Thomas,

die Vorgehensweise ist doch folgende: alle Punkte selektieren, dann das Makro starten, richtig?

Für das "mySelection" (1. Zeile) kommt dann aber die Fehlermeldung "Objekt not found".

Braucht man eine spezielle Installation?

Gruss,

Cornelius

------------------
Wenn etwas nicht klappt probier ich einfach was anderes - vielleicht klappt das auch nicht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ja,
einen Geoset haben,
die Punkte alle auswählen ( ich habe es nicht im Baum ausgewählt, sondern am Bildschirm gefangen
und dann das Makro starten

Code:

---

Sub CATMain()
'Set CATIA = GetObject("", "CATIA.Application") 'nur für xls
Dim myPartDocument
Set myPartDocument = CATIA.ActiveDocument
Set mypart = myPartDocument.Part
Set myAxis = mypart.CreateReferenceFromObject(mypart.AxisSystems.Item("Absolute Axis System")) 'Axis mit dem Namen erforderlich

'erzeuge ein neues Geoset mit namen Linien
Set myHybridBodies = mypart.hybridBodies.Add()
    myHybridBodies.Name = "Linien"
'Geoset Linien als Wert behalten
Set myhybridBody = mypart.hybridBodies.Item("Linien")
Set mySelection = CATIA.ActiveDocument.Selection
'Schleife 
  Anzahl = mySelection.Count
        For i = 1 To Anzahl Step 2
            Set APt = mySelection.Item(i).Value
            Set EPt = mySelection.Item(i + 1).Value
            Set myhybridShapeFactory = mypart.HybridShapeFactory
            Set myhybridShapeLinePtPt = myhybridShapeFactory.AddNewLinePtPt(APt, EPt)
            myhybridBody.AppendHybridShape myhybridShapeLinePtPt
        Next
'update
    mypart.Update
End Sub

---

habe es mal geändert - so sollte es laufen (habe es aber nur aus Excel laufen lassen

HTH

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

tmp1.jpg tmp2.jpg tmp3.jpg

Hi Thomas,

hat super geklappt, das Ergebniss (eines Teils) ist auf dem Bild zu sehen.

Vielen Dank,

Cornelius 

------------------
Wenn etwas nicht klappt probier ich einfach was anderes - vielleicht klappt das auch nicht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP