| |
| KISTERS 3DViewStation: 3D-Visualisierung für After Sales, Service und Ersatzteile, eine Pressemitteilung
|
Autor
|
Thema: Bohrung über Makro (7863 mal gelesen)
|
andrehh1985 Mitglied
Beiträge: 54 Registriert: 06.02.2011 Catia V5 R19
|
erstellt am: 20. Jul. 2012 07:40 <-- editieren / zitieren --> Unities abgeben:
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 |
moppesle Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 3425 Registriert: 28.05.2009 CATIA V5 R19 SP9 WIN 7 64bit
|
erstellt am: 20. Jul. 2012 08:17 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
|
andrehh1985 Mitglied
Beiträge: 54 Registriert: 06.02.2011 Catia V5 R19
|
erstellt am: 20. Jul. 2012 08:34 <-- editieren / zitieren --> Unities abgeben:
|
moppesle Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 3425 Registriert: 28.05.2009 CATIA V5 R19 SP9 WIN 7 64bit
|
erstellt am: 20. Jul. 2012 09:17 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
andrehh1985 Mitglied
Beiträge: 54 Registriert: 06.02.2011 Catia V5 R19
|
erstellt am: 20. Jul. 2012 09:59 <-- editieren / zitieren --> Unities abgeben:
|
thomasacro Ehrenmitglied V.I.P. h.c. Ingenieur Anwendungsberater
Beiträge: 3724 Registriert: 12.05.2004 V4 V5 2016 - 2020 V6 2016x -2019x
|
erstellt am: 20. Jul. 2012 10:05 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
moppesle Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 3425 Registriert: 28.05.2009 CATIA V5 R19 SP9 WIN 7 64bit
|
erstellt am: 20. Jul. 2012 10:06 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
|
andrehh1985 Mitglied
Beiträge: 54 Registriert: 06.02.2011 Catia V5 R19
|
erstellt am: 20. Jul. 2012 10:24 <-- editieren / zitieren --> Unities abgeben:
|
moppesle Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 3425 Registriert: 28.05.2009 CATIA V5 R19 SP9 WIN 7 64bit
|
erstellt am: 20. Jul. 2012 10:38 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
andrehh1985 Mitglied
Beiträge: 54 Registriert: 06.02.2011 Catia V5 R19
|
erstellt am: 20. Jul. 2012 10:57 <-- editieren / zitieren --> Unities abgeben:
|
tberger Mitglied Application Manager CATIA V5 / V6
Beiträge: 1385 Registriert: 13.01.2007
|
erstellt am: 27. Jul. 2012 08:38 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
Hamlet Mitglied Konstruktions- und Entwicklungsingenieur
Beiträge: 57 Registriert: 14.05.2013 Catia V5 R21 Windows XP 64bit
|
erstellt am: 14. Mai. 2013 10:23 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
Thomas Harmening Ehrenmitglied V.I.P. h.c. Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 NX12
|
erstellt am: 14. Mai. 2013 18:09 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
Hamlet Mitglied Konstruktions- und Entwicklungsingenieur
Beiträge: 57 Registriert: 14.05.2013
|
erstellt am: 15. Mai. 2013 08:02 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 15. Mai. 2013 08:07 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
|
Hamlet Mitglied Konstruktions- und Entwicklungsingenieur
Beiträge: 57 Registriert: 14.05.2013
|
erstellt am: 15. Mai. 2013 08:52 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
|
Thomas Harmening Ehrenmitglied V.I.P. h.c. Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 NX12
|
erstellt am: 15. Mai. 2013 20:01 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
|
Hamlet Mitglied Konstruktions- und Entwicklungsingenieur
Beiträge: 57 Registriert: 14.05.2013
|
erstellt am: 16. Mai. 2013 13:58 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
|
Stefan H Mitglied Konstrukteur / CAD-Admin (Proe/Creo)
Beiträge: 94 Registriert: 30.07.2010 Catia V5R19 (VW- und Standardumgebung) NVIDIA Quadro FX 3800 Intel W3530 @ 2,8GHz / 8GB RAM Win7 Prof. SP1 64bit
|
erstellt am: 16. Mai. 2013 15:44 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
Thomas Harmening Ehrenmitglied V.I.P. h.c. Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 NX12
|
erstellt am: 17. Mai. 2013 20:25 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
|
Thomas Harmening Ehrenmitglied V.I.P. h.c. Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 NX12
|
erstellt am: 07. Jun. 2013 17:53 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 08. Jun. 2013 10:13 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
Thomas Harmening Ehrenmitglied V.I.P. h.c. Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 NX12
|
erstellt am: 10. Jun. 2013 21:23 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 10. Jun. 2013 21:45 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
Thomas Harmening Ehrenmitglied V.I.P. h.c. Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 NX12
|
erstellt am: 13. Jun. 2013 18:40 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
max0211r Mitglied
Beiträge: 29 Registriert: 02.02.2017 Catia V5 R24
|
erstellt am: 22. Jun. 2017 08:25 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 22. Jun. 2017 09:53 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
Nelson Munz Mitglied Dipl.-Ing.
Beiträge: 24 Registriert: 14.07.2009 Windows 7 Catia V5 R18-R24
|
erstellt am: 20. Dez. 2017 01:41 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 20. Dez. 2017 09:48 <-- editieren / zitieren --> Unities abgeben: Nur für andrehh1985
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 |