Autor
|
Thema: Original aus Muster auslesen (1541 mal gelesen)
|
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 07. Apr. 2008 14:46 <-- editieren / zitieren --> Unities abgeben:
Hallo, Kann ich per Macro aus einem Muster im Part auslesen, was für ein Objekt gemustert wurde? In diesem bestimmten Fall möchte ich auslesen, ob das Objekt der Musterung eine Bohrung oder eine Gewindebohrung ist. Geht so etwas? ------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~ Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 07. Apr. 2008 15:04 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
Hallo, so ungefär müsstest du daran kommen. Dim Hole as Hole Dim Actpart as PartDocument Dim allPatterns As Selection Dim onePattern as Pattern Dim i as Integer 'Part selektieren set ActPart = Catia.Activdocument set allPatterns = ActPart.selection 'nach vorhanden Mustern suchen allPatterns.Search "CATPrtSearch.Pattern,all" 'die Items der Muster abfragen und evtl. Befehle ausführen for i = 1 to allpatterns.count Set onPattern = allPattern.Item(i).Value set Hole = onePattern.ItemToCopy If Hole.ThreadingMode = 0 then 'Befehle end if next HTH ------------------ MFG Rick Schulz Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 07. Apr. 2008 16:23 <-- editieren / zitieren --> Unities abgeben:
|
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008 Catia V5 R22SP5 Anbindung an SAP ERP 6.0 und PartSolutions 8.1.08 WinXP 64
|
erstellt am: 08. Apr. 2008 06:53 <-- editieren / zitieren --> Unities abgeben:
Die Funktion klappt, nun hab ich aber noch einen Fehler und weiss nicht warum. Zitat: Dim Hole Dim Actpart Dim allPatterns Dim onePattern Dim i Dim visPropertySet1 Dim ssSel'Part selektieren set ActPart = CATIA.ActiveDocument set allPatterns = ActPart.selection 'nach vorhanden Mustern suchen allPatterns.Search "CATPrtSearch.Pattern,all" 'die Items der Muster abfragen und evtl. Befehle ausführen for i = 1 to allpatterns.count Set onePattern = allPatterns.Item(i).Value set Hole = onePattern.ItemToCopy If Hole.ThreadingMode = 0 then Set ssSel = CATIA.ActiveDocument.Selection ssSel.clear ssSel.Add onePattern Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102,153,255,0 end if next
Das Macro färbt mir jetzt ein Muster, danach kommt der Fehler "Verfahren Item fehlgeschlagen"...
------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~ Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 08. Apr. 2008 08:15 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
Hallo, bei mir funktioniert dein Programm soweit, dass es die Bohrungen des Mustern in eine Art Blau färbt. Ein Fehler tritt bei mir nich auf. Ich nehme auch mal an, dass du dem Kind einen Namen(Sub Gewindefärben) gegeben hast. Hast du mal probiert per Schritt für Schritt das Makro auszuführen ... wenn ja wo steigt er denn aus? ------------------ MFG Rick Schulz Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 08. Apr. 2008 08:18 <-- editieren / zitieren --> Unities abgeben:
Das macro steigt hier Zitat:
Set onePattern = allPatterns.Item(i).Value
bei der 2ten Schleife aus. D.h. es wird nur ein Muster gefärbt, dann bricht das Macro mit o.g. Fehler ab. ------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~ Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 08. Apr. 2008 08:46 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
Hallo, du darfst nicht mit ssSel.Clear die Selection löschen. Wenn du das rausnimmst funktionierts. ------------------ MFG Rick Schulz Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 08. Apr. 2008 09:03 <-- editieren / zitieren --> Unities abgeben:
Zitat:
For i = 1 To allPatterns.count Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy Set ssSel = CATIA.ActiveDocument.Selection If Hole.ThreadingMode = 0 Then ssSel.clear ssSel.Add onePattern Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Else ssSel.clear ssSel.Add onePattern Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102, 204, 102, 0 End If Next
da hast du wohl recht. Aber dann färbt mir das Macro Musterungen von Bohrungen und Musterungen von Gewindebohrungen mit der Farbe des zuletzt aktivierten "onePattern.ItemToCopy" ein.
------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~ Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008 Catia V5 R22SP5 Anbindung an SAP ERP 6.0 und PartSolutions 8.1.08 WinXP 64
|
erstellt am: 08. Apr. 2008 13:00 <-- editieren / zitieren --> Unities abgeben:
So, bin etwas weiter gekommen, aber ich habe weiterhin das Problem, dass das Macro alle Muster im Part als Bohrungsmuster erkennt. Leider habe ich keinen lokalen VB-Editor und mit dem V5-internen lässt sich eine zeilenweise Abarbeitung des Macros zur Fehlersuche nicht machen. Denke aber, dass der Fehler irgendwie mit der Sel.Add methode zusammenhängt. Hat hier jemand noch eine Idee? Zitat:
'nach vorhandenen Mustern suchen allPatterns.Search "CATPrtSearch.Pattern,all" 'die Items der Muster abfragen verarbeiten For i = 1 To allPatterns.count On Error Resume Next Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy 'Verarbeitung fuer Bohrungsmuster If Hole.ThreadingMode = catSmoothHoleThreading Then ssSel.add onePattern Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Else End If Next ssSel.clear For k = 1 To allPatterns.count On Error Resume Next Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy If Hole.ThreadingMode = catThreadedHoleThreading Then ss2Sel.add onePattern Set visPropertySet2 = ss2Sel.VisProperties visPropertySet2.SetRealColor 102, 204, 102, 0 Else End If Next ss2Sel.clear
------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~
[Diese Nachricht wurde von DMaier am 08. Apr. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 08. Apr. 2008 13:19 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
wieso machst du ssSel.add und nicht Set ssSel? Ich nehme doch mal an, dass die als Selection definiert ist... ------------------ MFG Rick Schulz Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 08. Apr. 2008 13:40 <-- editieren / zitieren --> Unities abgeben:
Nein, ich habe gar nichts definiert, weil ich wie oben schon angedeutet, keinen externen VB-Editor habe, also VBScript schreibe. Wenn ich Set ssSel= onePattern setze, dann bringt die Zeile Set visPropertySet1 = ssSel.VisProperties den Fehler Object doesnt suppoert this Method: ssSel.VisProperties ich poste mal das restliche Macro. Der part mit den einzelnen Features läuft problemlos durch. Zitat:
Sub CATMain() 'Variablen Dim Hole Dim Actpart Dim allPatterns Dim onePattern Dim i Dim k Dim visPropertySet1 Dim ssSel Dim ss2Sel 'Selektionen auf aktuelles Dokument setzen Set Actpart = CATIA.ActiveDocument Set allPatterns = Actpart.Selection Set selection1 = CATIA.ActiveDocument.Selection Set selection2 = CATIA.ActiveDocument.Selection Set selection3 = CATIA.ActiveDocument.Selection Set ssSel = CATIA.ActiveDocument.Selection Set ss2Sel = CATIA.ActiveDocument.Selection 'Alle einzelnen Bohrungen, Gewindebohrungen und Gewinde suchen: 'Gewindebohrungen selection1.Search "'Part Design'.Bohrung.Gewinde=TRUE" Set visPropertySet1 = selection1.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 selection1.Clear 'Gewindefeature selection2.Search "'Part Design'.Gewinde" Set visPropertySet2 = selection2.VisProperties visPropertySet2.SetRealColor 102, 153, 255, 0 selection2.Clear 'Bohrungen selection2.Search "'Part Design'.Bohrung.Gewinde=FALSE" Set visPropertySet2 = selection2.VisProperties visPropertySet2.SetRealColor 102, 204, 102, 0 selection2.Clear 'nach vorhandenen Mustern suchen allPatterns.Search "CATPrtSearch.Pattern,all" 'die Items der Muster abfragen verarbeiten For i = 1 To allPatterns.count 'On Error Resume Next Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy 'Verarbeitung fuer Bohrungsmuster If Hole.ThreadingMode = catSmoothHoleThreading Then set ssSel= onePattern Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Else End If Next ssSel.clear
For k = 1 To allPatterns.count On Error Resume Next Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy If Hole.ThreadingMode = catThreadedHoleThreading Then Set ss2Sel= onePattern Set visPropertySet2 = ss2Sel.VisProperties visPropertySet2.SetRealColor 102, 204, 102, 0 Else End If Next ss2Sel.clear End Sub
------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~ [Diese Nachricht wurde von DMaier am 08. Apr. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 08. Apr. 2008 14:41 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
Hallo, das mit dem Selektieren scheint nicht sauber zu klappen. Achja und du hast vergessen den Fall einzuplanen, dass die Umgebungssprache variieren kann. Dadurch verändern sich auch die Suchbregriffe. folgender Code sollte aber deinen Wunsch erfüllen Sub CATMain() 'Variablen Dim Hole As Hole Dim Actpart As PartDocument Dim allPatterns As Selection Dim onePattern As Pattern Dim i As Integer Dim visPropertySet1 As VisPropertySet Dim ssSel As Selection Dim Selection1 As Selection Dim PatternsNO() As String Dim PatternsYes() As String Dim Index1 As Integer Dim Index2 As Integer 'Selektionen auf aktuelles Dokument setzen Set Actpart = CATIA.ActiveDocument Set allPatterns = Actpart.Selection Set Selection1 = CATIA.ActiveDocument.Selection Set ssSel = CATIA.ActiveDocument.Selection On Error Resume Next 'Alle einzelnen Bohrungen, Gewindebohrungen und Gewinde suchen: 'Deutsche Umgebung 'Gewindebohrungen Selection1.Search "'Part Design'.Bohrung.Gewinde=TRUE" Set visPropertySet1 = Selection1.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Selection1.Clear 'Gewindefeature Selection1.Search "'Part Design'.Gewinde" Set visPropertySet1 = Selection2.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Selection1.Clear 'Bohrungen Selection1.Search "'Part Design'.Bohrung.Gewinde=FALSE" Set visPropertySet1 = Selection2.VisProperties visPropertySet1.SetRealColor 102, 204, 102, 0 Selection1.Clear 'Englische Umgebung 'Gewindebohrungen Selection1.Search "'Part Design'.Hole.Threaded=TRUE" Set visPropertySet1 = Selection1.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Selection1.Clear 'Gewindefeature Selection1.Search "'Part Design'.thread" Set visPropertySet1 = Selection2.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Selection1.Clear 'Bohrungen Selection1.Search "'Part Design'.Hole.Threaded=FALSE" Set visPropertySet1 = Selection2.VisProperties visPropertySet1.SetRealColor 102, 204, 102, 0 Selection1.Clear 'nach vorhandenen Mustern suchen allPatterns.Search "CATPrtSearch.Pattern,all" 'die Items der Muster abfragen verarbeiten Index1 = 0 Index2 = 0 For i = 1 To allPatterns.Count 'On Error Resume Next Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy 'Verarbeitung fuer Bohrungsmuster If Hole.ThreadingMode = catThreadedHoleThreading Then ReDim Preserve PatternsYes(Index1) PatternsYes(Index1) = onePattern.Name Index1 = Index1 + 1 Else If Hole.ThreadingMode = catSmoothHoleThreading Then ReDim Preserve PatternsNO(Index2) PatternsNO(Index2) = onePattern.Name Index2 = Index2 + 1 End If End If Next ssSel.Clear Set ssSel = Actpart.Selection For i = 0 To Index1 - 1 ssSel.Search "Name='" & PatternsYes(i) & "';all" Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 ssSel.Clear Next For i = 0 To Index2 - 1 ssSel.Search "Name='" & PatternsNO(i) & "';all" Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102, 204, 102, 0 ssSel.Clear Next End Sub ------------------ MFG Rick Schulz Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 08. Apr. 2008 15:24 <-- editieren / zitieren --> Unities abgeben:
|
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008 Catia V5 R22SP5 Anbindung an SAP ERP 6.0 und PartSolutions 8.1.08 WinXP 64
|
erstellt am: 08. Apr. 2008 16:00 <-- editieren / zitieren --> Unities abgeben:
hab dann doch noch einen kleinen Wermutstropfen gefunden... Wenn ich etwas anderes mustere als Bohrungen, dann färbt er das auch mit ein ------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~ Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 08. Apr. 2008 16:23 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
So müsstes aber jetzt funktionieren. Ich habe eine Is Nothing Abfrage in der ersten Schleife hinzugefügt. For i = 1 To allPatterns.Count 'On Error Resume Next Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy 'Verarbeitung fuer Bohrungsmuster If Hole Is Nothing Then Resume Next Else If Hole.ThreadingMode = 0 Then ReDim Preserve PatternsYes(Index1) PatternsYes(Index1) = onePattern.Name Index1 = Index1 + 1 Else If Hole.ThreadingMode = 1 Then ReDim Preserve PatternsNO(Index2) PatternsNO(Index2) = onePattern.Name Index2 = Index2 + 1 End If End If End If Next Wir schaffen das
------------------ MFG Rick Schulz Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
[Diese Nachricht wurde von RSchulz am 08. Apr. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 08. Apr. 2008 16:33 <-- editieren / zitieren --> Unities abgeben:
Ja, ich glaube wir stehen kurz vorm Durchbruch nur über die Resume Next Anweisung fällt mein CatScript noch *grins* da murmelt er was von expected Statement... ------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~ Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 08. Apr. 2008 16:39 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
hmm... ich hab eh grad gesehen, dass ich da ein wenig rumgemüllt habe versuch es mal so ... und kauf dir mal ein VB For i = 1 To allPatterns.Count
'On Error Resume Next Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy 'Verarbeitung fuer Bohrungsmuster If Hole Is Nothing Then ElseIf Hole.ThreadingMode = 0 Then ReDim Preserve PatternsYes(Index1) PatternsYes(Index1) = onePattern.Name Index1 = Index1 + 1 ElseIf Hole.ThreadingMode = 1 Then ReDim Preserve PatternsNO(Index2) PatternsNO(Index2) = onePattern.Name Index2 = Index2 + 1 End If Next ------------------ MFG Rick Schulz
Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
[Diese Nachricht wurde von RSchulz am 08. Apr. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 08. Apr. 2008 16:43 <-- editieren / zitieren --> Unities abgeben:
Nee, das wars nich^^ Er färbt trotzdem ein gemustertes Pad. VB hab ich, nur keine Adminrechte zum Installieren Ich probiers zuhause nochmal, andernfalls meld ich morgen meinen Misserfolg Danke jedenfalls für die viele Mühe deinerseits. /edit, 2 Stunden später... klappt irgendwie nicht, selbst wenn ich Muster ohne "Featuretype catSimpleHole" aus der Schleife werfe, wird das gemusterte Pad mit eingefärbt. Bin langsam ratlos Zitat:
Sub CATMain() CATIA.Caption=theCATTitle 'Variablen Dim Hole 'As Hole Dim Actpart 'As PartDocument Dim allPatterns 'As Selection Dim onePattern 'As Pattern Dim i 'As Integer Dim visPropertySet1 'As VisPropertySet Dim ssSel 'As Selection Dim Selection1 'As Selection Dim PatternsNO() 'As String Dim PatternsYes() 'As String Dim Index1 'As Integer Dim Index2 'As Integer Dim FeatureType 'As Variant 'Selektionen auf aktuelles Dokument setzen Set Actpart = CATIA.ActiveDocument Set allPatterns = Actpart.Selection Set Selection1 = CATIA.ActiveDocument.Selection Set ssSel = CATIA.ActiveDocument.Selection On Error Resume Next 'Alle einzelnen Bohrungen, Gewindebohrungen und Gewinde suchen: 'Deutsche Umgebung 'Gewindebohrungen Selection1.Search "'Part Design'.Bohrung.Gewinde=TRUE" Set visPropertySet1 = Selection1.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Selection1.Clear 'Gewindefeature Selection1.Search "'Part Design'.Gewinde" Set visPropertySet1 = Selection2.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Selection1.Clear 'Bohrungen Selection1.Search "'Part Design'.Bohrung.Gewinde=FALSE" Set visPropertySet1 = Selection2.VisProperties visPropertySet1.SetRealColor 102, 204, 102, 0 Selection1.Clear 'Englische Umgebung 'Gewindebohrungen Selection1.Search "'Part Design'.Hole.Threaded=TRUE" Set visPropertySet1 = Selection1.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Selection1.Clear 'Gewindefeature Selection1.Search "'Part Design'.thread" Set visPropertySet1 = Selection2.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 Selection1.Clear 'Bohrungen Selection1.Search "'Part Design'.Hole.Threaded=FALSE" Set visPropertySet1 = Selection2.VisProperties visPropertySet1.SetRealColor 102, 204, 102, 0 Selection1.Clear 'nach vorhandenen Mustern suchen allPatterns.Search "CATPrtSearch.Pattern,all" 'die Items der Muster abfragen verarbeiten Index1 = 0 Index2 = 0 For i = 1 To allPatterns.Count 'On Error Resume Next Set onePattern = allPatterns.Item(i).Value Set Hole = onePattern.ItemToCopy 'Verarbeitung fuer Bohrungsmuster FeatureType = Hole.Type If FeatureType = catSimpleHole Then If Hole.ThreadingMode = 0 Then ReDim Preserve PatternsYes(Index1) PatternsYes(Index1) = onePattern.Name Index1 = Index1 + 1 ElseIf Hole.ThreadingMode = 1 Then ReDim Preserve PatternsNO(Index2) PatternsNO(Index2) = onePattern.Name Index2 = Index2 + 1
End If Else End if Next ssSel.Clear Set ssSel = Actpart.Selection For i = 0 To Index1 - 1 ssSel.Search "Name='" & PatternsYes(i) & "';all" Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102, 153, 255, 0 ssSel.Clear Next For i = 0 To Index2 - 1 ssSel.Search "Name='" & PatternsNO(i) & "';all" Set visPropertySet1 = ssSel.VisProperties visPropertySet1.SetRealColor 102, 204, 102, 0 ssSel.Clear Next CATIA.Caption="Catia V5" End Sub
------------------ ~~~ There are 10 types of people in the world: Those who understand binary, and those who don't... ~~~ [Diese Nachricht wurde von DMaier am 08. Apr. 2008 editiert.] [Diese Nachricht wurde von DMaier am 08. Apr. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008 Catia V5 R22SP5 Anbindung an SAP ERP 6.0 und PartSolutions 8.1.08 WinXP 64
|
erstellt am: 10. Apr. 2008 06:59 <-- editieren / zitieren --> Unities abgeben:
|
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 10. Apr. 2008 13:22 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
Hallo, das Object Hole ist bei mir nothing wenn das keine Bohrung ist. Wenn ich Zeit habe schau ich nochmal, ob ich da was finden kann... ------------------ MFG Rick Schulz Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 11. Apr. 2008 08:13 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von RSchulz: Hallo, das Object Hole ist bei mir nothing wenn das keine Bohrung ist. Wenn ich Zeit habe schau ich nochmal, ob ich da was finden kann...
Dann liegt das bestimmt daran, dass ich CATScript benutze und da die Variablen nicht mit Klassen einschränken kann.
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Moderator² Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007 @Work Lenovo P510 Xeon E5-1630v4 64GB DDR4 Quadro P2000 256GB PCIe SSD 512GB SSD SmarTeam V5-6 R2016 Sp04 CATIA V5-6 R2016 Sp05 E3.Series V2019 Altium Designer/Concord 19 Win 10 Pro x64
|
erstellt am: 11. Apr. 2008 08:55 <-- editieren / zitieren --> Unities abgeben: Nur für DMaier
Hallo, stimmt... Bei mir definier ich es ja als Hole somit werden Taschen etc. als nothing zurück gegeben. ------------------ MFG Rick Schulz Konfuzius sprach: "Wer sich das Alte noch einmal vor Augen führt, um das Neue zu verstehen, der kann anderen ein Lehrer sein."
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Konstrukteur (m/w/d) | Menschen und Technologien zu verbinden, den Perfect Match für unsere Kunden zu gestalten, immer die richtigen Expert:innen für die jeweilige Herausforderung zu finden - das ist unser Anspruch bei FERCHAU und dafür suchen wir dich: als ambitionierte:n Mitarbeitende:n für einen unserer Kunden. Wir realisieren spannende Projekte für namhafte Kunden in allen Technologiebereichen und für alle Branchen und arbeiten mit an anspruchsvollen Lösungen für die Industrie.... | Anzeige ansehen | Konstruktion, Visualisierung |
|
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 11. Apr. 2008 09:25 <-- editieren / zitieren --> Unities abgeben:
|