Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de
  CATIA V5 Programmierung
  Bohrung Werte auswerten

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
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für CATIA & Co.
  
KISTERS 3DViewStation optimiert die Lizenzverwaltung für ihre Kunden, eine Pressemitteilung
Autor Thema:  Bohrung Werte auswerten (894 / mal gelesen)
Rudi38
Mitglied
Konstrukteur

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

Beiträge: 8
Registriert: 21.09.2016

Workstation
Intel(R)Core(TM) i7-3930K
16G Ram
Quaddro 4000<P>Win7 64bit<P>Catia V5R24

erstellt am: 28. Sep. 2016 11: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

Hallo,

Ich möchte die Informationen einer Formsenkung auswerten um die Bohrung zu benennen und einzufärben.
Das Auslesen funktioniert auch die Toleranz, aber beim Auswerten der Toleranz gibt es einen Fehler ich weiss, warum?
Oder geht das an dieser Stelle nicht, in einer Normalen Bohrung geht das ja.

Code:
----------------------------------------------------------------

Sub CATMain()

    Dim objSel As Selection
    Dim objPartDoc As PartDocument
    Dim objHole, objPattern As Variant
    Dim i As Integer
 
    Set objPartDoc = CATIA.ActiveDocument
    Set objSel = objPartDoc.Selection

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

    If objSel.Count > 0 Then
        For i = 1 To objSel.Count
            Set objHole = objSel.Item(i).Value

    If objHole.Type = catCounterDrilledHole Then             
            objHole.HeadDiameter.MaximumTolerance > 0 And obj.Hole.HeadDiameter.MinimumTolerance = 0 Then (Hier bekomme ich einen Fehler)
          objHole.Name = "Ø" & objHole.HeadDiameter.Value & "H7 Tiefe: " & objHole.HeadDepth.Value & "mm" & objHole.HeadDiameter.MaximumTolerance
        End If
      Next
    End If

'Einfärben der  Passung H7--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole & Name=*H7*)"
objSel.VisProperties.SetRealColor 255, 0, 0, 1


'Muster---------------------------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von *H7*),all"
objSel.VisProperties.SetRealColor 255, 0, 0, 1


End Sub

------------------
MfG
Hendrik

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

joehz
Mitglied
Freiberuflicher Konstrukteur


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

Beiträge: 1057
Registriert: 25.11.2006

Win7 Pro 64 + Ubuntu + Irix6.5.20
Dell Precision M6600 i7-2960XM 2.7GHz 16GB
NVidia Quadro M5010
Catia V5R19
VB6Pro.SP6/VBA 6.5.1053

erstellt am: 28. Sep. 2016 11:52    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 Rudi38 10 Unities + Antwort hilfreich

Hi Rudi,

setz mal ein 'If' davor.

If objHole.HeadDiameter.MaximumTolerance

Tschau,
Joe

------------------
Inoffizielle Catia Hilfeseite

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

bgrittmann
Moderator
Konstrukteur


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

Beiträge: 12054
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 28. Sep. 2016 11:54    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 Rudi38 10 Unities + Antwort hilfreich

Servus Hendrik
Fehlt am Anfang der Zeile nicht noch ein If (und später auch ein End If)

Gruß
Bernd

PS: Ist es nicht etwas gewagt aus der Auswertung obere Toleranz ist >0 auf eine H7-Passung zu schließen?

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

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

Rudi38
Mitglied
Konstrukteur

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

Beiträge: 8
Registriert: 21.09.2016

Workstation
Intel(R)Core(TM) i7-3930K
16G Ram
Quaddro 4000<P>Win7 64bit<P>Catia V5R24

erstellt am: 28. Sep. 2016 13:14    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


Passbohrungen.CATPart

 
Hallo,

Danke erstmal für eure schnellen Anworten, ich habe das "IF" gesetzt und auch "End IF".
Bekomme dann an der selben stelle den Fehler.

@Bernd wir tragen eingenlich bei uns keine Toleranzen ein ausser bei einer H7 um die Bohrung einzufärben.

Code:
-----------------------------------------
    If objSel.Count > 0 Then
        For i = 1 To objSel.Count
            Set objHole = objSel.Item(i).Value

    If objHole.Type = catCounterDrilledHole Then             
            If objHole.HeadDiameter.MaximumTolerance > 0 And obj.Hole.HeadDiameter.MinimumTolerance = 0 Then
          objHole.Name = "Ø" & objHole.HeadDiameter.Value & "H7 Tiefe: " & objHole.HeadDepth.Value & "mm" & objHole.HeadDiameter.MaximumTolerance
        End If
End If
      Next
    End If

------------------
MfG
Hendrik

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

bgrittmann
Moderator
Konstrukteur


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

Beiträge: 12054
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 28. Sep. 2016 13:20    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 Rudi38 10 Unities + Antwort hilfreich

Servus
kleiner Tippfehler: es muss in der Zeile beides mal objHole heißen. (und nicht obj.Hole)

Gruß
Bernd

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

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

Rudi38
Mitglied
Konstrukteur

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

Beiträge: 8
Registriert: 21.09.2016

Workstation
Intel(R)Core(TM) i7-3930K
16G Ram
Quaddro 4000<P>Win7 64bit<P>Catia V5R24

erstellt am: 28. Sep. 2016 13:56    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 Bernd,

Danke das war der Fehler habe das ganze jetzt eingebaut funktioniert bestens.
Da ich ja nicht soviel plan vom Scripten habe hier mal der ganze Code, gibt es da noch Vorscläge zur vereinfachung oder verbesserung?

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
        For i = 1 To objSel.Count
            Set objHole = objSel.Item(i).Value
              If objHole.ThreadingMode = catThreadedHoleThreading Then
            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
          objHole.Name = "Ø" & objHole.Diameter.Value & "H7 Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
    Else objHole.Name = "Ø" & objHole.Diameter.Value & "mm Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
            End If

      If objHole.Type = catCounterDrilledHole Then             
            If objHole.HeadDiameter.MaximumTolerance > 0 And objHole.HeadDiameter.MinimumTolerance = 0 Then
              objHole.Name = "Ø" & objHole.HeadDiameter.Value & "H7 Tiefe: " & objHole.HeadDepth.Value & "mm"
        End If
End If
        Next
    End If

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

'Einfärben Standartbohrung--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole & Name=Ø*)"
objSel.VisProperties.SetRealColor 125, 0, 50, 1


'Muster---------------------------------------------------

objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von Ø*),all"
objSel.VisProperties.SetRealColor 125, 0, 50, 1

'Einfärben der  Passung H7--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole & Name=Ø*H7*)"
objSel.VisProperties.SetRealColor 255, 0, 0, 1


'Muster---------------------------------------------------

objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von Ø*H7*),all"
objSel.VisProperties.SetRealColor 255, 0, 0, 1

'Einfärben der  Feingewinde--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.ThreadDescription = M*x*),all"
objSel.VisProperties.SetRealColor 226, 172, 8, 1


'Muster---------------------------------------------------

objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von M*x*),all"
objSel.VisProperties.SetRealColor 226, 172, 8, 1

'Einfärben der Normalgewinde-----------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.ThreadDescription = M* & CATPrtSearch.Hole.ThreadDescription = M* & CATPrtSearch.Hole.ThreadDescription!=M*x*),all"
objSel.VisProperties.SetRealColor 255, 210, 10, 1


'Muster--------------------------------------------------

objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von M* & CATPrtSearch.Pattern.Name!=Muster von M*x*),all"
objSel.VisProperties.SetRealColor 255, 210, 10, 1

'Einfärben der Rohrgewinde--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.ThreadDescription = G*),all"
objSel.VisProperties.SetRealColor 197, 133, 6, 1


'Muster-------------------------------------------------

objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von G*),all"
objSel.VisProperties.SetRealColor 197, 133, 6, 1


         
End sub

------------------
MfG
Hendrik

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

joehz
Mitglied
Freiberuflicher Konstrukteur


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

Beiträge: 1057
Registriert: 25.11.2006

Win7 Pro 64 + Ubuntu + Irix6.5.20
Dell Precision M6600 i7-2960XM 2.7GHz 16GB
NVidia Quadro M5010
Catia V5R19
VB6Pro.SP6/VBA 6.5.1053

erstellt am: 28. Sep. 2016 16:06    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 Rudi38 10 Unities + Antwort hilfreich

Hi Hendrik,

ein paar kleine Anmerkungen:
Statt

Code:

Dim objHole, objPattern, objChamfer, objFillet, objThread As Variant

kannst auch
Code:

Dim objHole, objPattern, objChamfer, objFillet, objThread

schreiben.
'Variant' ist der Default-Typ.

Statt

Code:

  If Left(objPattern.Name, 1) = "#" Then 'wenn # dann nichts ändern
  Else
    objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name
  End If


geht auch
Code:

  If Left(objPattern.Name, 1) <> "#" Then 'wenn <> # dann ändern
    objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name
  End If


Sonst fällt mir auf die Schnelle nix auf.

Tschau,
Joe

------------------
Inoffizielle Catia Hilfeseite

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

Thomas Harmening
Ehrenmitglied V.I.P. h.c.
Arbeiter ツ



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

Beiträge: 2897
Registriert: 06.07.2001

NX 10
Win 7

erstellt am: 28. Sep. 2016 17: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 Rudi38 10 Unities + Antwort hilfreich

Steinsuppe

Man nehmen einen Topf und einen Stein, ein jeder der vorbeikommt bringt etwas mit :-)

Quelle: http://ww3.cad.de/foren/ubb/Forum133/HTML/010058.shtml#000022

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)2025 CAD.de | Impressum | Datenschutz