---

Hallo,

ich möchte mittels einer Punktewolke auf jeden Punkt eine Kugel mit Durchmesser 8mm erzeugen. Bis jetzt weiss ich nur die eine Vorgehensweise, indem ich auf jeden Punkt eine Kugel manuell erzeuge. Da ich aber mehrere Catparts mit bis zu 250 Punkte habe, die zufällig im Raum verteilt sind, gestaltet sich das doch zu einer großen Fleissarbeit.
Stichpunkt: 3D-Darstellung von Schweißpunkten im Karosseriebau.
Sollte hier sich schon jemand darüber Gedanken gemacht haben, bitte lasst es mich wissen.
Vielen Dank schon mal im voraus.

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

---

erzeuge dir eine Powercopy oder Udf mit einem isolierten PT und einer Spähre und wende die 250 mal an. aber selbst manuell wäre das noch keine Fleissarbeit - da gibt es schlimmeres  ?

Alternativ schreibe ein Makro

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

---

Hallo Thomas,

wie funktioniert das mit einem Makro, habe wenige bis keine Kenntnisse in Makroerstellung.
Mit der Powercopy oder Udf werde ich morgen gleich ausprobieren.
Danke.

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

---

hmmm... Consultant ...

wie das mit dem Makro funktioniert?
Ich habe bislang mich noch nicht in die Makroprogrammierung unter V5 herangetraut, da mir die Oberfläche und das debuggen mir arg grausig vorkommt - (auch weil ich kein Programmierer bin).

Aber generelle Vorgehensweise:

Erstmal Aufzeichnen, 1 oder 2 Spähren erzeugen und den Quellcode analysieren und daraus lernen.
Da ich mit dem integrierten Editor nichts anfangen kann, wechsle ich auf Excel, dort in die Entwicklungsumgebung, setze meine Verweise zu den dlls und beginne mit

Code:

---

Sub CATMain()
Set CATIA = GetObject("", "CATIA.Application")

---

setze ein paar überwachungsausdrücke, damit ich weiss, welche Wert herangezogen werden und versuche dann das ganze dymamisch zu machen
Was anfänglich aufgezeichnet so ausssieht:

Code:

---

Sub CATMain()
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapePointCoord1 = hybridShapes1.Item("Point.1")
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
Set axisSystems1 = part1.AxisSystems
Set axisSystem1 = axisSystems1.Item("Absolute Axis System")
Set reference2 = part1.CreateReferenceFromObject(axisSystem1)
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapeSphere1 = hybridShapeFactory1.AddNewSphere(reference1, reference2, 20#, -45#, 45#, 0#, 180#)
hybridShapeSphere1.Limitation = 1
hybridBody1.AppendHybridShape hybridShapeSphere1
part1.InWorkObject = hybridShapeSphere1
part1.Update
Set hybridShapePointCoord2 = hybridShapes1.Item("Point.2")
Set reference3 = part1.CreateReferenceFromObject(hybridShapePointCoord2)
Set reference4 = part1.CreateReferenceFromObject(axisSystem1)
Set hybridShapeSphere2 = hybridShapeFactory1.AddNewSphere(reference3, reference4, 20#, -45#, 45#, 0#, 180#)
hybridShapeSphere2.Limitation = 1
hybridBody1.AppendHybridShape hybridShapeSphere2
part1.InWorkObject = hybridShapeSphere2
part1.Update
End Sub

---

und kann am Ende so aussehen

Code:

---

Sub CATMain()
Set CATIA = GetObject("", "CATIA.Application")
Dim myPartDocument As Document

Set myPartDocument = CATIA.ActiveDocument
Set myPart = myPartDocument.Part
Set myAxis = myPart.CreateReferenceFromObject(myPart.AxisSystems.Item("Absolute Axis System")) 'Axis mit dem Namen erforderlich

Set myHybridBodies = myPart.HybridBodies.Add()
    myHybridBodies.Name = "Spähren"
Set mySelection = CATIA.ActiveDocument.Selection
   
    Anzahl = mySelection.Count
        For i = 1 To Anzahl
            Set Pt = mySelection.Item(i).Value
            Set myhybridShapeFactory = myPart.HybridShapeFactory
            Set myhybridShapeSphere = myhybridShapeFactory.AddNewSphere(Pt, myAxis, 4, -45, 45, 0, 180)
                myhybridShapeSphere.Limitation = 1
                myHybridBodies.AppendHybridShape myhybridShapeSphere
                myPart.InWorkObject = myhybridShapeSphere
        Next
    myPart.Update
End Sub

---

nun nur noch Zeile 2 und 3 verändern und es ist als *.catvbs lauffähig.
AktiveAxis muss so lauten ->Absolute Axis System
alle Punkte auswählen und makrostarten,
die Spähren werden in einem neuen Geoset angelegt.

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

---

Hallo Thomas,

habe das Makro ausprobiert und das hat toll funktioniert.

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

---

Hab es so gemacht, aber was muss den in Zeile 2 und 3 noch verändert werden?

------------------
Danke schon mal!

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

---

da ich scripte mangels einem VB-Editor immer über excel teste

Code:

---

Sub CATMain()
'Set CATIA = GetObject("", "CATIA.Application") wird nur von excel benötigt
Dim myPartDocument 'As Document die Deklarierung kann auch weg 

---

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