Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  CATIA V5 Programmierung
  Original aus Muster auslesen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  Original aus Muster auslesen (1541 mal gelesen)
DMaier
Mitglied
Key-User CAD/PLM/ERP


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 07. Apr. 2008 14:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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

HTHHope this helps (Hoffe, es hilft weiter)

------------------
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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 07. Apr. 2008 16:23    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

sieht optisch gut aus, teste das dann morgen mal 
vielen Dank soweit.

------------------
~~~ 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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 08. Apr. 2008 08:18    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 08. Apr. 2008 09:03    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 08. Apr. 2008 13:40    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 08. Apr. 2008 15:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

DingDing *Jackpot* 20 Unities auf dein Konto 

Danke vielmals

------------------
~~~ 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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 08. Apr. 2008 16:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 08. Apr. 2008 16:43    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hab mal den Parameter Hole.Type (FeatureType) ausgelesen, der gibt bei jedem Muster, egal ob das gemusterte Objekt eine Tasche, ein Block oder eine Bohrung ist, den Wert 0 zurück 

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

RSchulz
Moderator²
Head of CAD, Content & Collaboration / IT-Manager



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 11. Apr. 2008 08:13    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für DMaier 10 Unities + Antwort hilfreich

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 ansehenKonstruktion, Visualisierung
DMaier
Mitglied
Key-User CAD/PLM/ERP


Sehen Sie sich das Profil von DMaier an!   Senden Sie eine Private Message an DMaier  Schreiben Sie einen Gästebucheintrag für DMaier

Beiträge: 182
Registriert: 09.04.2008

erstellt am: 11. Apr. 2008 09:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Super, dann werd ich das Thema hier als abgeschlossen deklarieren 
Vielen Dank nochmal für den von dir hier investierten Gehirnschmalz.

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz