---

Guten Tag alle zusammen,

ich probiere im Moment ein Makro zu programmieren, mit welchem ich in Catia V5R21 in einer Baugruppe alle Löcher finden kann,welche einen bestimmten Durchmesser haben. Ich habe mir bereits das "Kochbuch" von Herrn Hansen zugelegt und dieses durchgearbeitet, habe aber leider trotzdem keine Idee wie ich die Programmierung durchführen soll, damit ich nicht alle Löcher auswähle, sondern nur die mit einem bestimmten Durchmesser, in welche dann automatisch Normstifte eingefügt werden sollen.

Gibt es dafür eine Möglichkeit oder ist die Suchfunktion in einem Makro so eingeschrängt, das es lediglich Löcher ohne und mit Gewinden finden kann?

Vielleicht habt ihr ja eine Idee, wie ich das schaffen könnte.

Mit freundlichem Gruß
lamdiabolo

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

---

Servus
Willkommen im Forum. Bitte Systeminfo ausfüllen.
Möglicher ABlauf:
- alle Löcher suchen (was ist mit gemusterten Bohrungen?)
- mit einer Schleife alle gefundenen Element durcharbeiten
- jedes Element prüfen:
      - richtiger Durchmesser
      - Gewinde vorhanden
- entsprechnede Elementa aus Selektion entfernen.

Gruß
Bernd

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

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

---

Zitat:

---

...mit einem bestimmten Durchmesser:

---

Code:

---

Dim length1 As Length
Set length1 = hole1.Diameter

if length1.Value = 6.000000 Then  '----- wenn Durchmesser z.B. 6mm ist, tut etwas
...
..
.

---

Zitat:

---

Löcher ohne und mit Gewinden finden kann?

---

Code:

---

if hole1.ThreadingMode = catThreadedHoleThreading Then   
MsgBox "Mit Gewinde"

else
MsgBox "Ohne Gewinde"
end if

---

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

---

Vielen Dank, ich werde es schnellst möglich vervollständigen!

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

---

Habe jetzt mal probiert einzelne Durchmesser aus einem Bauteil einzufärben. Hat leider nicht so ganz funktioniert. Wird immer ein Laufzeitfehler ausgegeben.
Damit ihr euch das mal genauer anschauen könnt, im folgenden mein Code:

Sub CATMain()
set document1 = catia.activedocument
set selection1 = document1.selection

dim durchmesser as integer
durchmesser= inputbox("Bitte geben sie den gesuchten Durchmesser ein!","Eingabe gesuchter Durchmesser", Durchmesser)

selection1.search ".hole,all"

dim laenge as length
set laenge=hole.diameter
if laenge.value= durchmesser then

set vispropertyset1=laenge.visproperties
vispropertyset1.setrealcolor 255,0,0,0
selection1.clear()
end if

set documents1 = catia.documents
for h=1 to documents1.count
on error resume next
set partdocument1 = documents1.item (h)
next

End Sub

Danke für eure Hilfe!

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

---

Servus
Wahrscheinlich musst du den String "durchmesser" noch "casten" (Typumwandlung): zB CDbl(durchmesser)

Gruß
Bernd

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

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

---

Danke Bernd
hat aber leider auch so nicht funktioniert.
Hatte noch was neues ausprobiert, da mir Catia immer gesagt hat : "Objekt erforderlich: 'hole1'. Ich wollte erst ALLE Löcher finden, welche danach nach ihrem Durchmesser durchgefragt werdenl. Hat aber leider auch nicht funktioniert, da dann der Fehler: "Das Objekt unterstützt diese Eigenschaft oder Methode nicht:'hole1.diameter'"

Mein "neuer" Code ist:
Sub CATMain()
set document1 = catia.activedocument
set selection1 = document1.selection

dim durchmesser as integer
durchmesser= inputbox("Bitte geben sie den gesuchten Durchmesser ein!","Eingabe gesuchter Durchmesser", Durchmesser)

selection1.search ".hole,all"

set hole1 =selection1.selection
dim laenge as length
set laenge=hole1.diameter
if laenge.value= durchmesser then

set vispropertyset1=laenge.visproperties
vispropertyset1.setrealcolor 255,0,0,0
selection1.clear()
end if

set documents1 = catia.documents
for h=1 to documents1.count
on error resume next
set partdocument1 = documents1.item (h)
next

End Sub

Vielen Dank nochmal für die schnelle Hilfe bzw. Beantwortung meiner Fragen.
MfG
Jan

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

---

Servus
So kannst du nicht auf die Selektierten Element zugreifen. Du musst über eine Schleife jedes Element "abarbeitet": zB (ungtestet)

Code:

---

selection1.search ".hole,all"
dim laenge as length
for i = 1 to selection1.count
    set hole1 =selection1.item2(i).value
    set laenge=hole1.diameter
    if laenge.value= durchmesser then  'ggf musst du hier noch schauen dass du die Variablentypen angleichst
        set vispropertyset1=laenge.visproperties
        vispropertyset1.setrealcolor 255,0,0,0
    end if
next
selection1.clear()

---

Gruß
Bernd

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

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

---

Servus zurück,

die Fehlermeldungen kommen jetzt nicht mehr und das Makro geht auch alle Löcher durch,findet jedoch leider nicht das EINE Loch und färbt daher auch keines der Löcher ein.
Ich bin leider nicht geübt genug in der Programmierung, um herauszufinden woran das liegen könnte. Ich probiere mal alles durch und schaue mir nochmal das Buch von Herrn Hansen an, ob da eventuell ähnlich Programmierungen bei sind. Vielleicht finde ich ja Übereinstimmungen.

Falls jemand noch eine Idee hat, woran es liegen könnte, ich freue mich über jeden Kommentar und jede Hilfe.
Danke schonmal im Vorraus.

Gruß
Jan

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

---

Habe erst einmal ausprobiert die einzelnen Löcher mit ihren Durchmessern einzeln zu finden.Das klappt jetzt.
Leider erkennt die unterste If- Funktion den Wahrheitsgehalt nicht, sie gibt immer die Else- Anweisung an.

Sub CATMain()

set selection1 =catia.activedocument.selection

selection1.search ".hole,all"
dim laenge as length
dim hole1 as integer
dim durchmesser as integer
durchmesser = inputbox ("Bitte geben sie den gesuchten Durchmesser an!", "Eingabe gesuchter Durchmesser", durchmesser)

for i = 1 to selection1.count
    set hole1 =selection1.item2(i).value
    set laenge=hole1.diameter
dim ausgabe as integer
ausgabe = laenge.value
dim box as long
box=msgbox (selection1.item2(i).value.name &" = " & ausgabe & "mm",48,"Durchmesser Löcher!")

if durchmesser = ausgabe then
box=msgbox(" Durchmesser entspricht gesuchtem Durchmesser")

else

box=msgbox("Durchmesser entspricht nicht gesuchtem Durchmesser")

end if

next

selection1.clear

End Sub

Hatte über eine Msg-Box die Werte von AUSGABE und DURCHMESSER ausgeben lassen und es wurden beide Werte erkannt.
Meine Frage ist jetzt, wieso die If- Bedingung nicht als Wahr erkannt wird, wenn die Werte übereinstimmend sind?

Mit freundlichem Gruß
Jan

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

---

Hier muß man also zu einem Trick greifen.

Zuerst speichert man die einzelnen Elemente der Selection in ein Array:

Code:

---

Dim SelElemente() As Object
ReDim SelElemente(Selection1.Count)
For i = 1 To Selection1.Count
  Set SelElemente(i) = Selection1.Item(i)
Next i

---

Dann löscht man die Selection und weist der Selection einzeln die gespeicherten Objecte zu:

Code:

---

For i = 1 To UBound(SelElemente)
  Selection1.Clear
  Selection1.Add SelElemente(i).Value
  ...
  ..
  .
Next i

---

So kommst Du in Bohrung rein:

Code:

---

Sub CATMain()

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("PartBody")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim hole1 As Shape
Set hole1 = shapes1.Item("Hole.1")

Dim length1 As Length
Set length1 = hole1.Diameter

dim durchmesser
durchmesser = inputbox ("Bitte geben sie den gesuchten Durchmesser an!", "Eingabe gesuchter Durchmesser", durchmesser)

dim durchmesser2
durchmesser2 = CDbl(durchmesser)

if length1.Value = durchmesser2 then
MsgBox "Passt!"

else
msgBox "Passt nicht!"

end if

End Sub

---

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

---

Servus
Ich behaupte dass der wirksame Unterschied liegt nur bei der Typkonvertierung ist:

Code:

---

if length1.Value = CDbl(durchmesser9 then

---

Die Slektion muss zwischen durch ja nicht geleert bzw neu verwendet werden.

Gruß
Bernd

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

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

---

Hallo Bernd,

Du hast natürlich völlig Recht.

Aber die Methode GetRealColor gilt immer für die ganze Selection.
Wenn lamdiabolo einfärben möchte, AFAIK soll es machen.

[Diese Nachricht wurde von imation1999 am 18. Apr. 2013 editiert.]

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

---

Servus
Stimmt auch wieder.
Rechthabermodus: Aber du kannst ja erst die Selektion prüfen (ggf Bohrungen entfernen) und dann erst einfärben.

Gruß
Bernd

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

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

---

Leider habe ich eure Anweisungen nicht genau verstanden, zumindest nicht so gut, das mein Makro jetzt einwnadfrei läuft.
Denke ich habe wieder total triviale Fehler eingebaut, welche den einwandfreien Lauf stören.

Code:

Sub CATMain()
set selection1 =catia.activedocument.selection
selection1.search ".hole.threaded=true,all"

for i = 1 to selection1.count
Dim SelElemente() As Object
ReDim SelElemente(Selection1.Count)
for i = 1 to selection1.count
Set SelElemente(i) = Selection1.Item(i)
Next i

For i = 1 To UBound(SelElemente)
  Selection1.Clear
  Selection1.Add SelElemente(i).Value
next i

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("PartBody")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim hole1 As Shape
Set hole1 = shapes1.Item("Hole.1")

Dim length1 As Length
Set length1 = hole1.Diameter

dim ausgabe as integer
ausgabe =length1.value
dim box as long
box=msgbox (selection1.item2(i).value.name &" = " & ausgabe & "mm",48,"Durchmesser Löcher!")

dim durchmesser
durchmesser = inputbox ("Bitte geben sie den gesuchten Durchmesser an!", "Eingabe gesuchter Durchmesser", durchmesser)

dim durchmesser2
durchmesser2 = CDbl(durchmesser)

if length1.Value = durchmesser2 then
set vispropertyset1 =selection1.visproperies
vispropertyset1.setrealcolor 0,255,255,0

else
msgBox "Passt nicht!"

end if

set documents1 = catia.documents
for h=1 to documents1.count
on error resume next
set partdocument1 = documents1.item (h)
next

End Sub

Aber trotzdem vielen Dank für die schnelle Antwort.
Gruß
Jan

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

---

Versuch mal mit folgende Code:

Code:

---

Sub CATMain()

set selection1 = CATIA.ActiveDocument.Selection

'----nach Bohrungen suchen
Selection1.search ".hole,all"                     

'----Selection sichern
Dim SelElemente() As Object
ReDim SelElemente(Selection1.Count)
For i = 1 To Selection1.Count
  Set SelElemente(i) = Selection1.Item(i)
Next

dim length1 as length
dim hole1

dim durchmesser
durchmesser = inputbox ("Bitte geben sie den gesuchten Durchmesser an!", "Eingabe gesuchter Durchmesser", durchmesser)

'----Selection wieder herstellen
For i = 1 To UBound(SelElemente)
Selection1.Clear
Selection1.Add SelElemente(i).Value

set hole1 = selection1.item2(1).value

Set length1 = hole1.Diameter

'----den Durchmesser prüfen, dann die Bohrung einfärben
if length1.Value = CDbl(durchmesser) then
Selection1.VisProperties.setrealcolor 255,0,0,0

end if

next

selection1.clear

End Sub

---

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

---

Danke es funktioniert!

Dieses Forum ist wirklich super.
Ich habe Professoren gefragt die Catia unterrichten, aber nicht einmal die hatten eine Ahnung wie ich das mit Makros lösen könnte.

Vielen Dank.

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

---

Servus
Es geht sogar noch einfacher: nur mit der Suche kann man schon die entsprechenden Bohrungen (mit dem passenden Durchmesser) selektieren:

Code:

---

Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = partDocument1.Selection

selection1.Search "CATPrtSearch.Hole.Diameter=4,3mm,all"

selection1.VisProperties.SetRealColor 255, 0, 0, 0

End Sub

---

Jetzt noch eine Inputbox für den Durchmesser einbauen, und fertig.

Gruß
Bernd

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

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

---

Hat bei mir leider nicht so ganz geklappt, aber wie ihr bestimmt bis jetzt herausgefunden habt, bin ich auch nicht der Allerbeste im Programmieren.

Falls ihr so nett seit und mir noch bei einer Sache helfen würdet, wäre ich euch sehr dankbar.
Ich würde gerne die Anzahl aller Löcher mit den jeweiligen Durchmessern in einer Liste ausgeben.

Also beispielhaft:
5 x 50mm
2 x 30mm
1 x 10mm

Hatte dies mal im VBA mit einer Listbox ausprobiert, doch da werden mir die Löcher nacheinander angezeigt und nicht summiert:
Loch1 50mm
Loch2 30mm
Loch3 50mm
Loch4 10mm
.
.
.

Danke für eure Hilfe.
Gruß
Jan

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

---

http://ww3.cad.de/foren/ubb/Forum137/HTML/005320.shtml

Falls es jemand benötigt!

Vielen Dank an alle die mir behilflich waren.

Gruß
Jan

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