---

Hallo Leute,

ich bin noch Anfänger was das Arbeiten mit Catia angeht.

Ich konstruiere Vorrichtungen und da müssen in Passstücke immer Bohrungen vom Typ M6 und 6H7 hinein.

Mein Anliegen:

Ich würde es gerne so haben, dass ich nur den Punkt und die Fläche markiere und dann per Makro die Bohrung hinein bringe. Ist das machbar mit der Makroaufzeichnung?

Zuerst hatte ich es versucht das ich den Punkt und die Fläche markiert habe und dann die Makroaufzeichnung gestartet habe. Was ich nicht bedacht hatte war, dass das Makro dann natürlich auf diesen einen Punkt bezogen ist. Es muss also total unabhängig sein.

Vielleicht kann mir ja jemand helfen.

Gruß

Andre

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

---

Hallo Andre,

das kannst du auch mit einer PowerCopy bewerkstelligen.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

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

---

Das sagt mir erst mal noch gar nichts 

Kann man ein Makro erstellen und es anschließend so bearbeiten das es keinen Bezug mehr zu irgendwelchen Flächen und Punkten hat?

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

---

Hallo andrehh1985,

also eine Powercopy ist das beste was Dassault zu Catia beigetragen hat. (ist meine Meinung)

Stell dir folgendes vor.
Du ertsellst dir die M6 und 6H7Žer Bohrungen.
Diese haben Stützelemente wie z.B. Plane für den Sketch und Punkte für die Positionierung der Bohrungen.

Von diesen erzeugst du dir eine Powercopy.In deinem Ziehlpart fügst du diese ein und referenzierst die Stützelemente (in deinem Fall Plane und Punkte)

Nun hast du deine Bohrungen die total unabhängig sind von deiner Quelldatei.

Goggle mal nach Powercopy.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

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

---

Na das war ja doch ganz einfach 

Kann man das PowerCopy dann auch über ein Makro auführen?

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

---

Hi Andrehh.
Ich kann (wie immer    ) auch hier uwe nur zustimmen: Powercopy ist das, was du probieren solltest!
WARUM möchtest du das in ein Makro einbinden? Was sollte dieses besser oder mehr können als die Powercopy?

------------------
gruß, Tom  

[Diese Nachricht wurde von thomasacro am 20. Jul. 2012 editiert.]

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

---

Das funktioniert auch,

dazu gab es schon einige Beiträge hier.
Einfach mal SuFu verwenden.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

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

---

@ Tom

so könnte ich mir die Makro-Befehle (das dass PowerCopy ausführt) direkt in die Befehlszeile legen und schneller aufrufen.

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

---

Hallo andrehh1985,

Zitat:

---

so könnte ich mir die Makro-Befehle (das dass PowerCopy ausführt) direkt in die Befehlszeile legen und schneller aufrufen.

---

Mit dem Befehl "Instantiate from Ducument" hast du genau das was du mit dem Makro machen willst.

Aber gut. Warum einfach, wenn es auch kompliziert geht.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

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

---

Danke...

wie gesagt...ich bin Anfänger in Catia

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

---

Hallo Andre,

du kannst bereits definierte PowerCopies auch über ein Icon starten.
Das findest du auch im Forum.

------------------
Grüße aus dem Thurgau
Thomas

+++++++++++++++++++++++++++++++++

CATIA - eine Laune der Natur ...

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

---

Hallo zusammen,

Ich bin relativ neu hier (5min) und sehr unerfahren mit Catia V5 Makros.
Ich benutze vbscribt und habe als ausgangssituation irgendein Part mit einer Anzahl von Bohrungen x, welche in unterschiedlicher Reihenfolge im Part erstellt worden sind.
Dadurch haben die Bohrungen jetzt eine Nummerierung wie z.b.
Hole.5
Hole.3
Hole.10
Hole.1

Ich will jetzt mittels Makro die Holes umbenennen, komme aber gerade nicht weiter:

Set partdoc = CATIA.ActiveDocument
Set selection1 = partdoc.Selection

name1 = "hole."

selection1.Search "CATPrtSearch.Hole.Diameter>0mm,all"

For k=1 To selection1.Count

selection1.item(k).name = name1 & k
(Hier wird der Fehler angezeigt)

k = k+ 1

Next

Kann mir vll. Jmd. Helfen und sagen was und warum es falsch ist?

Danke im voraus

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

---

v5testeinfaerben.png V5R19.test.Einfaerbenundumbennen.CATPart

hmmm,
ungetestet - müsste es heissen 

Code:

---

selection1.Item(k).Value.Name = name1 & k

---

Aber warum nur ein schnödes Durchnumerieren? hat IMHO keinen besonderen Nutzen.

Aus verschiedenen CodeSchnippsel, ausbaufähig     

das Makro benennt
ein Loch mit dem Ø und der Tiefe
Ein Gewinde mit Mxx und txx sowie Kernloch und Kernlochtiefe benamsen
Muster werden als Pattern von  Ø und der Tiefe benannt
Gewinde werden Gelb eingefärbt.

Ausbaufähig wäre noch,

Alle Radien (Solid und viell. GSD) mit Radiengrösse benamsen
Bohrlöcher einfärben, die nicht eine gewisse Bohrgüte aufweisen müssen
H7 Bohrungen separat einfärben
boolsche Operationen wie Body umbenennen...
den Code schöner schreiben^^

Code:

---

Sub CATMain()
    Dim objSel As Selection
    Dim objPartDoc As PartDocument
    Dim arrHole() As Object
    Dim objHole As Variant
    Dim i As Integer
    Dim objVisProp As VisPropertySet
   
    Set objPartDoc = CATIA.ActiveDocument
   
    Set objSel = objPartDoc.Selection
    objSel.Clear
    objSel.Search "CATPrtSearch.Hole,all"
   
    '***ES GIBT BOHRUNGEN
    If objSel.Count > 0 Then
        '***HAT DIE BOHRUNG EIN GEWINDE?
        For i = 1 To objSel.Count
            Set objHole = objSel.Item(i).Value
            'aaa = objHole.Diameter.Value
            'Name = objHole.Name
            'objHole.Name = objHole.Diameter.Value
            If objHole.ThreadingMode = catThreadedHoleThreading Then
                objHole.Name = "GEWINDE M" & objHole.ThreadDiameter.Value & "_t" & objHole.ThreadDepth.Value & "____KERNLOCH: " & objHole.Diameter.Value & "mm_TIEFE: " & objHole.BottomLimit.Dimension.Value & "mm"
                Else
            objHole.Name = "Ø_" & objHole.Diameter.Value & "mm_TIEFE: " & objHole.BottomLimit.Dimension.Value & "mm"
            End If
        Next
    Else
        Exit Sub
    End If
   
    objSel.Clear

    '***Einfärben der Gewinde
Set MySel = objPartDoc.Selection
    'MySel.Search "Name=GEWINDE*,all" Suche über Bez
    MySel.Search "(CATPrtSearch.Hole.Threaded=TRUE),all" 'Suche über Gew und Muster  + CATPrtSearch.Thread
   
    MySel.VisProperties.SetRealColor 255, 255, 0, 1

'Muster-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Pattern,all"

For i = 1 To objSel.Count
    Set pat1 = objSel.Item(i).Value
    'pattern1.Add objSel.Item(i).Value
    objname = objSel.Item(i).Value.ItemToCopy.Name
    pat1.Name = "Pattern von " & objname
Next
End Sub

---

[Diese Nachricht wurde von Thomas Harmening am 15. Mai. 2013 editiert.]

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

---

Als Erstes: Danke!!!! 

Bezüglich der "nur einfachen Nummerierung":

Ich brauch/darf halt nicht mehr, da ich strikt Anforderungen habe was solche Bestandtteile der Parts angeht und es sollte nur ein erster Anfang sein, um später vll. noch gewissen Bestandtteile eines Geometrical Sets zu nummerieren. 

Deine Lösung mit dem ".Value.Name" lässt das Programm jetzt auch ohne Fehler durchlaufen, was schonmal super ist.

Jedoch habe ich beim Test herausgefunden, dass es nicht 100% arbeitet, was ich nicht ganz nachvollziehen kann, denn die FOR-Schleife ist recht simpel und sollte derartige Fehler nicht hervorbringen.

Mein Test-Part hat 4 Bohrungen und nach der Ausführung sollte eigentlich stehen:

hole.1
hole.2
hole.3
hole.4

Ausgangssituation ist:

Hole.4
Hole.2
Hole.3
Hole.1

Ich habe sowohl die Nummern als auch die Gross/Kleinschreibung als Indikator für die Funktionsfähigkeit des Programmes überprüft.

Leider sieht das Ergebnis so aus:

hole.1
Hole.2
hole.3
Hole.1

Hätte jmd. noch eine Idee warum das Ergebnis so ausfällt?

Hier nochmal der derzeitige Code.
-----------------------------------------
Sub CATMain()
Set partDocument1 = CATIA.ActiveDocument
Set selection1 = partDocument1.Selection
name1 = "hole."

selection1.Search "CATPrtSearch.Hole.Diameter>0mm,all"

For k=1 To selection1.Count
selection1.item(k).Value.Name = name1 & k
k = k + 1
Next

End Sub
-----------------------------------------

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

---

Servus
lass mal die Zeile "k = k + 1" weg. Die For-Next-Schleife zählt von allein hoch.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Das war es!!    
Danke

[Diese Nachricht wurde von Hamlet am 15. Mai. 2013 editiert.]

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

---

schön, das es geklappt hat ;-)

BTW

selection1.Search "CATPrtSearch.Hole.Diameter>0mm,all"

- was wird da ausgeschlossen? ^^ ;-)

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

---

Ich wollte einfach alle Bohrungen erfassen und wusste nicht genau wie ich das einfacher machen kann 

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

---

Zitat:

---

Original erstellt von Thomas Harmening:
hmmm,
...
Aus verschiedenen CodeSchnippsel, ausbaufähig      

das Makro benennt
ein Loch mit dem Ø und der Tiefe
Ein Gewinde mit Mxx und txx sowie Kernloch und Kernlochtiefe benamsen
Muster werden als Pattern von  Ø und der Tiefe benannt
Gewinde werden Gelb eingefärbt.

Ausbaufähig wäre noch,

Alle Radien (Solid und viell. GSD) mit Radiengrösse benamsen
Bohrlöcher einfärben, die nicht eine gewisse Bohrgüte aufweisen müssen
H7 Bohrungen separat einfärben
boolsche Operationen wie Body umbenennen...
den Code schöner schreiben^^

---

Hallo Thomas,

Danke für diese schöne Anregung !
Ich bin ganz neu in Catia und Script ist auch Neuland für mich.

Ich habe mich trotzdem mal aus wissenschaftlichem Interesse auf das Script gestürzt. 

* Done:
- Code aufgeräumt
- Fasen
- Radien
- Außengewinde hinzu

* TODO:
- Code schöner machen ;)
- Bodies umbenennen (Wage ich mich nächste Woche ran, habe morgen Urlaub  )

Getestet und funktioniert soweit mit meinem Testmodell wunderbar.

Für Anregeungen und Verbesserungsvorschläge bin ich sehr dankbar.

Code:

---

Sub CATMain()
    Dim objSel As Selection
    Dim objPartDoc As PartDocument
    Dim objHole, objPattern, objChamfer, objFillet, objThread As Variant
    Dim i As Integer
 
    Set objPartDoc = CATIA.ActiveDocument
    Set objSel = objPartDoc.Selection

    objSel.Clear
    objSel.Search "CATPrtSearch.Hole,all"
'Bohrungen----------------------------------------------
    If objSel.Count > 0 Then '***ES GIBT BOHRUNGEN
        For i = 1 To objSel.Count
            Set objHole = objSel.Item(i).Value
              If objHole.ThreadingMode = catThreadedHoleThreading Then '***HAT DIE BOHRUNG EIN GEWINDE?
                objHole.Name = "M" & objHole.ThreadDiameter.Value  & " - " & objHole.ThreadDepth.Value & "mm tief; Kernloch: " & objHole.Diameter.Value & "mm Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
              Else
            objHole.Name = "Ø" & objHole.Diameter.Value & "mm Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
            End If
        Next 
    End If
 

'Einfärben der Gewinde--------------------------------
    objSel.Clear
    objSel.Search "(CATPrtSearch.Hole.Threaded=TRUE),all"
    objSel.VisProperties.SetRealColor 255, 255, 0, 1
    objSel.Search "CATPrtSearch.Thread,all"
    objSel.VisProperties.SetRealColor 255, 255, 0, 1

'Muster-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Pattern,all"
    If objSel.Count > 0 Then
For i = 1 To objSel.Count
Set objPattern = objSel.Item(i).Value
objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name
Next
End If

'Fasen-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Chamfer,all"
    If objSel.Count > 0 Then
For i = 1 To objSel.Count
Set objChamfer = objSel.Item(i).Value
              If objChamfer.Mode =  catLengthAngleChamfer Then '***Fase mit Winkel
                objChamfer.Name = "Fase " & objChamfer.Length1.Value  & " x " & objChamfer.Angle.Value & "°"
                Else
objChamfer.Name = "Fase " & objChamfer.Length1.Value  & " x "  & objChamfer.Length2.Value
            End If
Next
End If

'Radien-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Fillet,all"
    If objSel.Count > 0 Then
For i = 1 To objSel.Count
Set objFillet = objSel.Item(i).Value
            objFillet.Name = "Verrundung R" & objFillet.Radius.Value  & " "
Next
End If

'Außengewinde-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Thread,all"
    If objSel.Count > 0 Then
For i = 1 To objSel.Count
Set objThread = objSel.Item(i).Value
objThread.Name = "M" & objThread.Diameter & " x " & objThread.Pitch & " - " & objThread.Depth & "mm lang"
Next
End If
objSel.Clear
End Sub

---

------------------
Viele Grüße

Stefan

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

---

bin Begeistert  & kurz angebunden, da nun 2 Wochen Urlaub
bis in 2,5 Wochen 

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

---

moin, moin,

Urlaub vorbei, es läuft vergleichbares ala www.youtube.com/watch?v=TCQppWC6iLE  

done:
Solidaufdickung hinzu,
Bohrungen die eine Toleranz 0/>0 haben werden als H7 bestimmt umd grün eingefärbt (andere H-Güten verwende ich nicht)
die h7 ist nur die umgekehrte Variante, aber habe noch nie eine h Bohrung gemacht  
Runden bei Aussgengewinde, da er bei mir manchmal M5,9999999999 etc. bringt - Macht er auch tw. bei Bohrungen

todo:
Feature, die aus irgendwelchen Gründen eine vom Anwender manuelle Änderung der Benamsung erfahren haben, sollten verständlicherweise nicht geändert werden.
User muss dazu ein vorangestelltes # eingeben - die wird dann erkannt und dementsprechend übersrungen.

Code:

---

Sub CATMain()
    Dim objSel As Selection
    Dim objPartDoc 'As PartDocument
    Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness As Variant
    Dim i As Integer

    Set objPartDoc = CATIA.ActiveDocument
    Set objSel = objPartDoc.Selection

    Set selection1 = CATIA.ActiveDocument.Selection
    Set visPropertySet1 = selection1.VisProperties
   
    objSel.Clear
    objSel.Search "CATPrtSearch.Hole,all"
   
    'H-Passungen liegen direkt über der Nulllinie, im Gegensatz dazu liegen h-Passungen direkt unter der Nulllinie. Die Größe des Toleranzfeldes ist unabhängig von der gewählten Toleranzlage.
  
'Bohrungen----------------------------------------------
Dim H7 As New Collection
If objSel.Count > 0 Then '***ES GIBT BOHRUNGEN
    For i = 1 To objSel.Count
    Set objHole = objSel.Item(i).Value
        If objHole.ThreadingMode = catThreadedHoleThreading Then                                      '***HAT DIE BOHRUNG EIN GEWINDE?
            objHole.Name = "M" & objHole.ThreadDiameter.Value & " - " & objHole.ThreadDepth.Value & "mm tief; Kernloch: " & objHole.Diameter.Value & "mm Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
        ElseIf objHole.Diameter.MaximumTolerance > 0 And objHole.Diameter.MinimumTolerance = 0 Then   '***IST DIE BOHRUNG MIT TOLERANZ - Es wird H7 angenommen
            objHole.Name = "Ø" & objHole.Diameter.Value & "H7 [" & objHole.Diameter.MinimumTolerance & "/" & objHole.Diameter.MaximumTolerance & "] Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
            H7.Add objSel.Item(i).Value
        ElseIf objHole.Diameter.MaximumTolerance = 0 And objHole.Diameter.MinimumTolerance < 0 Then  '***IST DIE BOHRUNG MIT TOLERANZ - Es wird h7 angenommen
            objHole.Name = "Ø" & objHole.Diameter.Value & "h7 [" & objHole.Diameter.MinimumTolerance & "/" & objHole.Diameter.MaximumTolerance & "] Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
        Else
            objHole.Name = "Ø" & objHole.Diameter.Value & " Tiefe: " & objHole.BottomLimit.Dimension.Value
        End If
    Next
End If

objSel.Clear

'Einfärben H7----------------------------------------
For i = 1 To H7.Count
    selection1.Add H7.Item(i)
Next
visPropertySet1.SetRealColor 0, 255, 0, 1 'Oliv grün 175,255,175
selection1.Clear

'Einfärben der Gewinde--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.Threaded=TRUE),all"
objSel.VisProperties.SetRealColor 255, 255, 0, 1 'Gelb 255,255,0 'Weiß 255,255,255
objSel.Search "CATPrtSearch.Thread,all"
objSel.VisProperties.SetRealColor 255, 255, 0, 1

'Muster-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Pattern,all"
    If objSel.Count > 0 Then
For i = 1 To objSel.Count
Set objPattern = objSel.Item(i).Value
objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name
Next
End If

'Fasen-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Chamfer,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objChamfer = objSel.Item(i).Value
        If objChamfer.Mode = catLengthAngleChamfer Then  '***Fase mit Winkel
            objChamfer.Name = "Fase " & objChamfer.length1.Value & " x " & objChamfer.Angle.Value & "°"
        Else
            objChamfer.Name = "Fase " & objChamfer.length1.Value & " x " & objChamfer.Length2.Value
        End If
    Next
End If

'Radien-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Fillet,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objFillet = objSel.Item(i).Value
        objFillet.Name = "Verrundung R" & objFillet.Radius.Value & " "
    Next
End If

'Außengewinde-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Thread,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objThread = objSel.Item(i).Value
        objThread.Name = "M" & Round(objThread.Diameter, 1) & " x " & objThread.Pitch & " - " & objThread.Depth & "mm lang"
    Next
End If

'Aufdickungen-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Thickness,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objThickness = objSel.Item(i).Value
        objThickness.Name = "Aufdickung " & objThickness.Offset.Value & "mm"
    Next
End If

'weitere Features-----------------------------------------------
objSel.Clear
End Sub

---

[Diese Nachricht wurde von Thomas Harmening am 07. Jun. 2013 editiert.]

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

---

Servus
Dann will ich auch mal meinen Beitrag leisten:
- Bei Rundungen den Sonderfall "Tritangentfillet" ausschließen
- Boolesche Operationen umbenennen

Code:

---

Sub CATMain()
    Dim objSel 'As Selection
    Dim objPartDoc 'As PartDocument
    Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness, objBooleOperation, visPropertySet1 As Variant
    Dim i As Integer
    Dim StrBooleOperation As String

    Set objPartDoc = CATIA.ActiveDocument
    Set objSel = objPartDoc.Selection

    Set visPropertySet1 = objSel.VisProperties
 
    objSel.Clear
    objSel.Search "CATPrtSearch.Hole,all"
 
    'H-Passungen liegen direkt über der Nulllinie, im Gegensatz dazu liegen h-Passungen direkt unter der Nulllinie. Die Größe des Toleranzfeldes ist unabhängig von der gewählten Toleranzlage.
 
'Bohrungen----------------------------------------------
Dim H7 As New Collection
If objSel.Count > 0 Then '***ES GIBT BOHRUNGEN
    For i = 1 To objSel.Count
    Set objHole = objSel.Item(i).Value
        If objHole.ThreadingMode = catThreadedHoleThreading Then                                      '***HAT DIE BOHRUNG EIN GEWINDE?
            objHole.Name = "M" & objHole.ThreadDiameter.Value & " - " & objHole.ThreadDepth.Value & "mm tief; Kernloch: " & objHole.Diameter.Value & "mm Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
        ElseIf objHole.Diameter.MaximumTolerance > 0 And objHole.Diameter.MinimumTolerance = 0 Then  '***IST DIE BOHRUNG MIT TOLERANZ - Es wird H7 angenommen
            objHole.Name = "Ø" & objHole.Diameter.Value & "H7 [" & objHole.Diameter.MinimumTolerance & "/" & objHole.Diameter.MaximumTolerance & "] Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
            H7.Add objSel.Item(i).Value
        ElseIf objHole.Diameter.MaximumTolerance = 0 And objHole.Diameter.MinimumTolerance < 0 Then  '***IST DIE BOHRUNG MIT TOLERANZ - Es wird h7 angenommen
            objHole.Name = "Ø" & objHole.Diameter.Value & "h7 [" & objHole.Diameter.MinimumTolerance & "/" & objHole.Diameter.MaximumTolerance & "] Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
        Else
            objHole.Name = "Ø" & objHole.Diameter.Value & " Tiefe: " & objHole.BottomLimit.Dimension.Value
        End If
    Next
End If

objSel.Clear

'Einfärben H7----------------------------------------
For i = 1 To H7.Count
    objSel.Add H7.Item(i)
Next
visPropertySet1.SetRealColor 0, 255, 0, 1 'Oliv grün 175,255,175
objSel.Clear

'Einfärben der Gewinde--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.Threaded=TRUE),all"
objSel.VisProperties.SetRealColor 255, 255, 0, 1 'Gelb 255,255,0 'Weiß 255,255,255
objSel.Search "CATPrtSearch.Thread,all"
objSel.VisProperties.SetRealColor 255, 255, 0, 1

'Muster-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Pattern,all"
    If objSel.Count > 0 Then
For i = 1 To objSel.Count
Set objPattern = objSel.Item(i).Value
objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name
Next
End If

'Fasen-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Chamfer,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objChamfer = objSel.Item(i).Value
        If objChamfer.Mode = catLengthAngleChamfer Then  '***Fase mit Winkel
            objChamfer.Name = "Fase " & objChamfer.length1.Value & " x " & objChamfer.Angle.Value & "°"
        Else
            objChamfer.Name = "Fase " & objChamfer.length1.Value & " x " & objChamfer.Length2.Value
        End If
    Next
End If

'Radien-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Fillet,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objFillet = objSel.Item(i).Value
        If TypeName(objFillet) <> "TritangentFillet" Then
            objFillet.Name = "Verrundung R" & objFillet.Radius.Value & objFillet.Radius.Unit.Symbol
        End If
    Next
End If

'Außengewinde-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Thread,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objThread = objSel.Item(i).Value
        objThread.Name = "M" & Round(objThread.Diameter, 1) & " x " & objThread.Pitch & " - " & objThread.Depth & "mm lang"
    Next
End If

'Aufdickungen-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Thickness,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objThickness = objSel.Item(i).Value
        objThickness.Name = "Aufdickung " & objThickness.Offset.Value & "mm"
    Next
End If

'Boolesche Operationen-----------------------------------------------
objSel.Clear
objSel.Search "(((((CATPrtSearch.Assemble + CATPrtSearch.Trim) + CATPrtSearch.Add) + CATPrtSearch.Intersect) + CATPrtSearch.Split )+ CATPrtSearch.Remove),all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objBooleOperation = objSel.Item(i).Value
        'Prüfen ob es sich um eine Boolesche Operation handlet. Ein Flächentrimm hat keine Methode Body
        On Error Resume Next
        If Not IsError(objBooleOperation.Body) Then
            Select Case TypeName(objBooleOperation)
            Case "Add"
                StrBooleOperation = "Hinzufügen "
            Case "Assemble"
                StrBooleOperation = "Zusammenbauen "
            Case "Intersect"
                StrBooleOperation = "Verschneiden "
            Case "Trim"
                StrBooleOperation = "Trimmen "
            Case "Split"
                StrBooleOperation = "Verschneiden "
            Case "Remove"
                StrBooleOperation = "Entfernen "
            End Select
            objBooleOperation.Name = StrBooleOperation & objBooleOperation.Body.Name
        End If
        On Error GoTo 0
    Next
End If

'weitere Features-----------------------------------------------
objSel.Clear

End Sub

---

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Danke Bernd   

ich werfe noch die Abfrage rein <wenn Benennung mit # beginnt, dann Featurebenennung nicht Ändern>

Ausserdem ist mit aufgefallen das ein Collection nicht auf den Scriptsprachen Catvbs und Catscript funktioniert
Arrays können da nur Zahlen oder String Elemente aufnehemen , keine Objekte...

muss man halt die mit 'CATVBA gekennzeichneten Zeilen auskommentieren
und die objSel.Search ("CATPrtSearch.Hole & Name=*H7*") mit reinnehmen.

Code:

---

Sub CATMain()
    Dim objSel 'As Selection
    Dim objPartDoc 'As PartDocument
    Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness, objBooleOperation, visPropertySet1 As Variant
    Dim i As Integer
    Dim StrBooleOperation As String

    Set objPartDoc = CATIA.ActiveDocument
    Set objSel = objPartDoc.Selection

    Set visPropertySet1 = objSel.VisProperties

    objSel.Clear
    objSel.Search "CATPrtSearch.Hole,all"

    'H-Passungen liegen direkt über der Nulllinie, im Gegensatz dazu liegen h-Passungen direkt unter der Nulllinie. Die Größe des Toleranzfeldes ist unabhängig von der gewählten Toleranzlage.

'Da catscript und catvbs reine skriptsprachen sind kann man keine Objekte in ein Array übergeben
'in diesen Fall die Zeilen mit CATVBA ausdokumentieren und das einfärben der H7 Bohrungen über die Suche aktivieren

'Bohrungen----------------------------------------------
Dim H7 As New Collection                    'CATVBA
If objSel.Count > 0 Then '***ES GIBT BOHRUNGEN
    For i = 1 To objSel.Count
    Set objHole = objSel.Item(i).Value
        If Left(objHole.Name, 1) = "#" Then 'wenn # dann nichts ändern
            ElseIf objHole.ThreadingMode = catThreadedHoleThreading Then                                      '***HAT DIE BOHRUNG EIN GEWINDE?
            objHole.Name = objHole.HoleThreadDescription.Value & " - " & objHole.ThreadDepth.Value & "mm tief; Kernloch: " & objHole.Diameter.Value & "mm Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
        ElseIf objHole.Diameter.MaximumTolerance > 0 And objHole.Diameter.MinimumTolerance = 0 Then  '***IST DIE BOHRUNG MIT TOLERANZ - Es wird H7 angenommen
            objHole.Name = "Ø" & objHole.Diameter.Value & "H7 [" & objHole.Diameter.MinimumTolerance & "/" & objHole.Diameter.MaximumTolerance & "] Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
            H7.Add objSel.Item(i).Value     'CATVBA
        ElseIf objHole.Diameter.MaximumTolerance = 0 And objHole.Diameter.MinimumTolerance < 0 Then  '***IST DIE BOHRUNG MIT TOLERANZ - Es wird h7 angenommen
            objHole.Name = "Ø" & objHole.Diameter.Value & "h7 [" & objHole.Diameter.MinimumTolerance & "/" & objHole.Diameter.MaximumTolerance & "] Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
        Else
            objHole.Name = "Ø" & objHole.Diameter.Value & " Tiefe: " & objHole.BottomLimit.Dimension.Value
        End If
    Next
End If

objSel.Clear

'Einfärben H7----------------------------------------
For i = 1 To H7.Count           'CATVBA
    objSel.Add H7.Item(i)       'CATVBA
Next                            'CATVBA
' objSel.Search ("CATPrtSearch.Hole & Name=*H7*") 'suche für Catscript & catvbs
visPropertySet1.SetRealColor 0, 255, 0, 1 'Oliv grün 175,255,175
objSel.Clear

'Einfärben der Gewinde--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.Threaded=TRUE),all"
objSel.VisProperties.SetRealColor 255, 255, 0, 1 'Gelb 255,255,0 'Weiß 255,255,255
objSel.Search "CATPrtSearch.Thread,all"
objSel.VisProperties.SetRealColor 255, 255, 0, 1

'Muster-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Pattern,all"
    If objSel.Count > 0 Then
For i = 1 To objSel.Count
    Set objPattern = objSel.Item(i).Value
        If Left(objPattern.Name, 1) = "#" Then 'wenn # dann nichts ändern
             Else
                objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name
        End If
               
Next
End If

'Fasen-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Chamfer,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objChamfer = objSel.Item(i).Value
        If Left(objChamfer.Name, 1) = "#" Then 'wenn # dann nichts ändern
        ElseIf objChamfer.Mode = catLengthAngleChamfer Then  '***Fase mit Winkel
            objChamfer.Name = "Fase " & objChamfer.length1.Value & " x " & objChamfer.Angle.Value & "°"
        Else
            objChamfer.Name = "Fase " & objChamfer.length1.Value & " x " & objChamfer.Length2.Value
        End If
    Next
End If

'Radien-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Fillet,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objFillet = objSel.Item(i).Value
        If Left(objFillet.Name, 1) = "#" Then 'wenn # dann nichts ändern
            ElseIf TypeName(objFillet) <> "TritangentFillet" Then
            objFillet.Name = "Verrundung R" & objFillet.Radius.Value & objFillet.Radius.unit.Symbol
        End If
    Next
End If

'Außengewinde-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Thread,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objThread = objSel.Item(i).Value
        If Left(objThread.Name, 1) = "#" Then
            Else
            objThread.Name = objThread.ThreadDescription.Value & " x " & objThread.Pitch & " - " & objThread.Depth & "mm lang"
        End If
    Next
End If

'Aufdickungen-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Thickness,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objThickness = objSel.Item(i).Value
        If Left(objThickness.Name, 1) = "#" Then
            Else
            objThickness.Name = "Aufdickung " & objThickness.Offset.Value & "mm"
        End If
    Next
End If

'Boolesche Operationen-----------------------------------------------
objSel.Clear
objSel.Search "(((((CATPrtSearch.Assemble + CATPrtSearch.Trim) + CATPrtSearch.Add) + CATPrtSearch.Intersect) + CATPrtSearch.Split )+ CATPrtSearch.Remove),all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objBooleOperation = objSel.Item(i).Value
        'Prüfen ob es sich um eine Boolesche Operation handlet. Ein Flächentrimm hat keine Methode Body
        On Error Resume Next
        If Left(objBooleOperation.Name, 1) = "#" Then 'wenn # dann nichts ändern
        ElseIf Not IsError(objBooleOperation.Body) Then
            Select Case TypeName(objBooleOperation)
            Case "Add"
                StrBooleOperation = "Hinzufügen "
            Case "Assemble"
                StrBooleOperation = "Zusammenbauen "
            Case "Intersect"
                StrBooleOperation = "Verschneiden "
            Case "Trim"
                StrBooleOperation = "Trimmen "
            Case "Split"
                StrBooleOperation = "Verschneiden "
            Case "Remove"
                StrBooleOperation = "Entfernen "
            End Select
            objBooleOperation.Name = StrBooleOperation & objBooleOperation.Body.Name
        End If
        On Error GoTo 0
    Next
End If

'weitere Features-----------------------------------------------
objSel.Clear

End Sub

---

@Bernd, den Vorschlag mittels "HoleThreadDescription" bzw "ThreadDescription" die Gewindeinformation herauszuholen, ist gleich  miteingearbeitet.

[Diese Nachricht wurde von Thomas Harmening am 11. Jun. 2013 editiert.]

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

---

Servus
Ich hätte noch einen weiteren Verbesserungsvorschlag:
Bei allen Gewinden über "HoleThreadDescription" bzw "ThreadDescription" die Größe auslesen, dann sollt es auch mit Gewinden aus Gewindetabellen klappen.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Code:

---

'Split-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Split,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
    Set objSplit = objSel.Item(i).Value
        If Left(objSplit.Name, 1) = "#" Then
            Else
            objSplit.Name = "Split von " & objSel.Item(i).Reference.Parent.Surface.DisplayName
        End If
    Next
End If

---

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

---

Auch wenn ich jetzt als Totengräber gelte, aber mir fehlt noch eine umbenennung von Senkungen...

Code:

---

ElseIf objHole.Type = catCounterboredHole then
            objHole.Name = "D1" & objHole.Diameter.Value & "-D2" & objHole.???.Value & "/" & objHole.???.Value & "tief"
     

---

Ich hab das Script für mich ergänzt:

Code:

---

'Einfärben der Partbody--------------------------------
objSel.Clear
selection1.Search "Name=*Partbody*,all"
objSel.VisProperties.SetRealColor 255, 128, 128, 1
objSel.Search "CATPrtSearch.Thread,all"
objSel.VisProperties.SetRealColor 255, 128, 128, 1

---

geht das auch eleganter als über die Suchfunktion?

Code:

---

'Einfärben Rohteil--------------------------------
objSel.Clear
selection1.Search "Name=*Rohteil*,all"
objSel.VisProperties.SetRealColor 255, 128, 128, 1
objSel.Search "CATPrtSearch.Thread,all"
objSel.VisProperties.SetRealColor 255, 128, 128, 1

---

Nur würde ich gerne Rohteile nach auslesen des Materials einfärben...

[Diese Nachricht wurde von max0211r am 22. Jun. 2017 editiert.]

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

---

Servus

Zur Senkung findest du hier schon eine Diskussion. Vielleicht ist da was passendes dabei. (bitte auch mal das Watch/Localfenster im VBA Editor verwenden)
Den Mainbody kannst du ach direkt ohne die Suche selektieren (sprachunabhängig):

Code:

---

selection1.Clear
selection1.add objPartDoc.Part.Mainbody
objSel.VisProperties.SetRealColor 255, 128, 128, 1

---

Was du mit dem Material und dem Rohteil vorhast hab ich noch nicht verstanden. Kannst du das näher beschreiben?

Kleiner Hinweis: bei Suchen über die Selektion möglichst den Filter so weit wie möglich einschränken. Sonst bekommst du ggf Objekttypen zurück die du nicht haben willst (vermutlich ist die Suche auch langsamer)

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Hallo Zusammen,

Zitat:

---

Original erstellt von Thomas Harmening:
[B]Danke Bernd    

Code:

---

'Muster-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Pattern,all"
    If objSel.Count > 0 Then
For i = 1 To objSel.Count
    Set objPattern = objSel.Item(i).Value
        If Left(objPattern.Name, 1) = "#" Then 'wenn # dann nichts ändern
            Else
                objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name
        End If
               
Next
End If

---

---

kann man erreichen, dass hier das gemusterte Objekt z.B. weiß eingefärbt wird?

Gruß
Nelson

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

---

Servus

Ja geht ähnlich wie hier:
ItemToCopy zwischenspeichern (Array oder Collection), wenn alle Pattern abgearbeitet sind, Selektion leeren, Elemente aus dem Zwischenspeicher selektieren und dann einfärben.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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