---

Hallo an die Gemeinde, ich habe schon viele Beiträge durchforstet aber nichts gefunden, das mir auch nur annähernd weiterhilft. Ich suche eine Möglichkeit Lines, Surfaces und PointŽs über ein Macro umzubenennen. Die Geometrien, liegen in einem bestimmten Ordner und sollen für eine Bearbeitungsfolge in WorkNC fit gemacht werden.
zB. line.1 soll später ein c_st_1 werden. Mir schwebt eine Abfrage - Selektion Handlung vor: selektiere die Line die zu c_st_1 werden soll usw. Die Abfrage sollte mit allen Begriffen "gefüttert" werden und nicht stoppen oder abstürzen, wenn die Geometrie nicht vorhanden ist. Zb: Selektion Ja - Nein - Weiter - Fertig, dann automatisch weiter zum nächsten Punkt oder beenden. Ich hoffe mal ich habe verständlich genug geschrieben und freue mich auf Tips, damit ich wenigstens mal einen Einstieg finde. Danke schonmal im voraus

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

---

Hallo,
Geometrieelemente (also lines etc) können nicht in Ordnern liegen. In Ordnern liegen Dateien. Meinst du GeometricalSets?
Ich hab auch noch noch nicht verstanden, wo genau dein Problem liegt?
Zum Thema umbenennen mittels Selektion gibts hier viele Beiträge.

Gruß

------------------
tomtom1972

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

---

Ja, da habe ich mich wohl falsch ausgedrückt, ich meinte GeometricalSets. (sind bei uns Ordner, umgangssprachlich) Es gibt sehr viele Beiträge, das ist richtig, ich habe nur noch keines gefunden wo man über eine Abfrage umbenennt, über die Suche nichts gefunden und alle durchlesen, dazu habe ich keine Zeit, es läuft neben dem Hauptgeschäft.

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

---

Servus
Der grobe Ablauf ist:
- mit UserSelection2 das GeoSet selektieren lassen und zwischen speichern
- - mit UserSelection2 die Linie selektieren lassen, mit .Parent (oder war es .Parent.Parent?) prüfen ob die Linie im richtigen GeoSet liegt
- Linie umbennenen
- mit einer Schleife die nächste Linien genauso abarbeit.
Da ich auch keine Zeit habe (wie fast alle hier im Forum), muss du den Code selbst zusammenbasteln (einlesen,s suchen und probieren)

Gruß
Bernd

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

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

---

Danke für die Antwort, ist schonmal ein Einstieg. Ich habe schon die Zeit ein Makro zu schreiben und zu testen, mir fehlt nur die Zeit alle Beiträge zu durchforsten, da bei uns die Internetnutzung protokolliert wird.

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

---

Zitat:

---

Original erstellt von ChiefJosef:
s gibt sehr viele Beiträge, das ist richtig, ich habe nur noch keines gefunden wo man über eine Abfrage umbenennt, über die Suche nichts gefunden und alle durchlesen, dazu habe ich keine Zeit, es läuft neben dem Hauptgeschäft.

---

Das soll jetzt aber keine Ausrede sein - denn da gibt es noch die Pausen, Freizeit etc. Von Nix kommt Nix. ;-)

- Line die zu c_st_1  // Woher soll das Script erkennen das linie zu c_st_1 wird // anhand des Geosets das c_st benannt ist // -1 ist eine fortlaufende Nummer die einfach hochgezählt werden darf.

- oder ist das Script nur ein Dialog und der user definiert dann über eine Userform die Werte für die Benennung?

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

---

Das soll auch keine Ausrede sein, aber nach einer 10std Schicht bleibt Zuhause der PC aus, mein Privatleben ist mir schon heilig und in einer halben Std Pause pro Tag das Forum zu durchforsten ist schwerlich möglich.
Das was ich hier vorhabe existiert bisher nur in meinem Kopf, ob es realisierbar ist weiß ich nicht weil ich mich in der Makroprogrammierung nicht auskenne.
Das Script soll das erkennen in dem es mich auffordert, die Linie die umbenannt werden soll zu selektieren.

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

---

Ist die Linie ein Bohrachse und soll den BohrØ, Güte und Länge beinhalten?

Dann würde ich alle Bohrungen suchen, die Achsen dazu erzeugen und dementsprechend benennen.

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

---

Nein einfache geometrische Linien und Kurven, wir benutzen WorkNC nur zur 3D Bearbeitung. Serienteile haben wir auch keine, deswegen ist es auch schwierig ein Makro zu schreiben das alles abdeckt.
Deswegen hätte ich ja gerne so eine Art Frage und Antwortspiel 

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

---

So, Grundstock habe ich erstmal das ganze muss noch ausgebaut werden, aber jetzt wißt ihr ungefähr was gemeint ist.
Option Explicit

Sub CATMain()
' _________________________
Dim element(1)
Debug.Print
Dim elementNamen
Dim workNC_Input_body As HybridBody
Dim iSel As Selection
Set iSel = CATIA.ActiveDocument.Selection
On Error Resume Next
Dim partDoc, elementTyp
Set partDoc = CATIA.ActiveDocument.part
  Set workNC_Input_body = CATIA.ActiveDocument.part.HybridBodies.Item("WorkNC_Input")
  elementNamen = Array("c_fla_aussen", "c_flachsenk", "c_kon", "c_schulter",)
  elementTyp = Array("Curve", "Curve", "Curve", "Curve")
If Err.Number Then
  'HybridBody erzeugen wenn nicht vorhanden
  ' Fehler wird ausgelöst wenn WorkNC_Input nicht vorhanden
    'Debug.Print Err.Number
  addHybridBodie "WorkNC_Input", workNC_Input_body, CATIA.ActiveDocument.part.HybridBodies
  Err.Clear
  On Error GoTo 0
End If
'Debug.Print UBound(elementNamen)
Dim ceLe
Dim addedEle
Dim i
For i = 0 To UBound(elementNamen)
If MsgBox("Wähle " & elementNamen(i), vbYesNo) = vbYes Then
    ' element Selectieren
    usfSelectElement Array(elementTyp(i)), "Wähle Element " & elementNamen(i), CATIA.ActiveDocument, ceLe
' -------------------
                    iSel.Add ceLe
                    'Debug.Print iSel.Item2(1).name, iSel.Item2(1).Value.name
                    'iSel.Item(1).Value.name = elementNamen(i)
                    iSel.Copy
                    'Debug.Print iSel.Item2(1).name, iSel.Item2(1).Value.name
                    iSel.Clear
                    iSel.Add workNC_Input_body
                    iSel.PasteSpecial ("CATPrtResultWithOutLink") '"CATIA_RESULT"
                   
                    iSel.Clear
                    'partdoc.Update
                    workNC_Input_body.HybridShapes.Item(workNC_Input_body.HybridShapes.Count).name = elementNamen(i)
                    'Debug.Print workNC_Input_body.HybridShapes.Item(workNC_Input_body.HybridShapes.Count).name
                    partDoc.Update
' --------------
End If
Next i
Exit Sub
cerror:

End Sub

Private Function usfSelectElement(element, message, currentDoc, setValue)
    Dim userSel
    Set userSel = currentDoc.Selection
    userSel.Clear
    Dim selState
    selState = userSel.SelectElement2(element, message, False)
    If (selState = "ok" Or selState = "Normal") Then
        Set setValue = userSel.Item(1).Value
    End If
End Function

Private Function addHybridBodie(cName, addedBodie, currBodies As HybridBodies)
    Set addedBodie = currBodies.Add
        addedBodie.name = cName
        'currentPart.Update
End Function

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

---

Um das aufzuhübschen habe ich mir überlegt mit Userforms ein Formular zu erstellen für eine Vorselektierung ( Haken setzen bei den später zu selektierenden Elementen)So dass nur das abgefragt wird was auch tatsächlich vorhanden ist. Wo finde ich Material zum einarbeiten in Userforms? Das Formular zu erstellen ist kein Problem, das was im Hintergrund abläuft, kann ich mir noch nicht so richig vorstellen. Hab jetzt erstmal einen Grundkurs besucht, der ging aber nicht soweit dass Userforms behandelt wurde, es wurde nur kurz gezeigt.
Danke mal im voraus

------------------
Ich hab keine Ahnung und davon sehr viel.

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

---

UserForms.jpg

Zitat:

---

Original erstellt von ChiefJosef:
Um das aufzuhübschen habe ich mir überlegt mit Userforms ein Formular zu erstellen für eine Vorselektierung ( Haken setzen bei den später zu selektierenden Elementen)So dass nur das abgefragt wird was auch tatsächlich vorhanden ist. Wo finde ich Material zum einarbeiten in Userforms? Das Formular zu erstellen ist kein Problem, das was im Hintergrund abläuft, kann ich mir noch nicht so richig vorstellen. Hab jetzt erstmal einen Grundkurs besucht, der ging aber nicht soweit dass Userforms behandelt wurde, es wurde nur kurz gezeigt.
Danke mal im voraus

---

Als Beispiel das angehängte Foto von der Eingabemaske

------------------
Ich hab keine Ahnung und davon sehr viel.

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

---

v5R19-outputelementenachGeosetnamen.CATPart

Zitat:

---

Ich suche eine Möglichkeit Lines, Surfaces und PointŽs über ein Macro umzubenennen. Die Geometrien, liegen in einem bestimmten Ordner und sollen für eine Bearbeitungsfolge in WorkNC fit gemacht werden.

---

Wenn die Geometrien eh in einem bestimmten Ordner liegen, die Ordner (Geosets) entsprechend Strukturieren und benennen.
Anwender legt dann die Geometrien in die dafür vorgesehen Geosets ab.
Makro durchläuft dann die definierten Geosets ab und benennt alle Features entsprechend dem Name vom Geoset.

unten ein abgeänderter Code -

Code:

---

'-------------------------------------------------NewNameOfJoins------------------------------------------------------------------------------------------------------
'Author:    Daniel Frauenrath
'Mail:         daniel.frauenrath@gmx.com
'Release:  26.03.2009
'Version:   1.0
'
'*************************************************************************************************************************************************************************
'<<<<<<<<<<<<<<<<Beschreibung / Discription>>>>>>>>>>>>>>>>>>>>
'**************************************************************************************************************************************************************************
'
'DE: Aendert die Namen von Joins auf den Namen der geometrischen Set in dem sich die
'      Joins befinden
'
'
'*************************************************************************************************************************************************************************
'<<<<<<<<<<<<<<<<Veränderungen / Change log>>>>>>>>>>>>>>>>>>>>
'**************************************************************************************************************************************************************************
'Autor:                Datum:          Zeile/Line:        Modul / UserForm:     Anmerkung/Remark:
'--------------------------------------------------------------------------------------------------------------------------
'
'
'
'
'****************************************************************************************************************************************************
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Hauptmakro>>>>>>>>>&  gt;>>>>>>>>>>>>>>>>>>>>>>>
'****************************************************************************************************************************************************

Sub CATMain()

'**********************************Abfrage Dokumente**********************************
    Dim oFenster As Windows
    Dim oDoc As Document
    Dim ObjType As String
    Set oFenster = CATIA.Windows
    If oFenster.Count = 0 Then
        Box = MsgBox("Es ist kein Dokument geladen!" + Chr(10) + "Das Makro kann nicht ausgeführt werden und wird beendet!", vbCritical, "Keine Dokument geladen")
        Exit Sub
    End If
    Set oDoc = CATIA.ActiveDocument
    ObjType = TypeName(oDoc)
    If ObjType <> "PartDocument" Then
        Box = MsgBox("Das aktive Dokument ist kein CATPart!" + Chr(10) + "Das Makro kann nicht ausgeführt werden!", _
                vbCritical + vbOKOnly, "Falscher Dateityp")
        Exit Sub
    End If

'**********************************Deklarationen**********************************
    Dim oPart As Part
    Dim GeoSet()
    Dim mySel As Selection
    Dim newSel As Selection
    Dim TheSelSet As Selection
    'Dim myJoin As HybridShapeAssemble '=Feature Join
    Dim mySet As HybridBody
    Dim mySetName As String
   
'**********************************Suchschleifen (mit Umbenennung)**********************************
    Set oDoc = CATIA.ActiveDocument
    Set oPart = oDoc.Part
    Set mySel = oDoc.Selection
    Set newSel = oDoc.Selection
    Set TheSelSet = oDoc.Selection
    mySel.Clear
    newSel.Clear
    newSel.Search "CATGmoSearch.OpenBodyFeature,all"
    For i = 1 To newSel.Count
        ReDim Preserve GeoSet(newSel.Count - 1)
        Set GeoSet(i - 1) = newSel.Item(i).Value
    Next
    newSel.Clear
    For ii = 0 To UBound(GeoSet)
        Set mySelSet = GeoSet(ii)
        TheSelSet.Add mySelSet
        mySel.Search "(CATGmoSearch.GSMAssemble + CATGmoSearch.Surface + CATGmoSearch.Line + CATGmoSearch.Curve + CATGmoSearch.Point),sel"   '(CATGmoSearch.Line + CATGmoSearch.Point),  '"CATGmoSearch.GSMAssemble,sel"
        For iii = 1 To mySel.Count
            Set myJoin = mySel.Item(iii).Value
            Set mySet = myJoin.Parent.Parent
            mySetName = mySet.Name
            'myJoin.Name = myJoin.Parent.Name & "_" & iii 'nur zum umbennen in dummy namen
            myJoin.Name = Mid(mySetName, 2, 99) & "_" & iii
        Next
        mySel.Clear
    Next
    oPart.Update
    mySel.Clear

End Sub

---

Nt: Dein obiger Code ist IMHO noch nicht sauber  -  eine Vorselektion mittes Userform ist natürlich auch möglich;-)
Dein Code habe ich aber ignoeriert:
- weil nicht schön lesbar formatiert ;-)
- eine Zeile rot aufleuchtete (komma am ende)
- ich nicht wirklich was auswählen konnte
- und bei manueller abarbeitung (F8) die Selektion wieder gelöscht wurde 

[Diese Nachricht wurde von Thomas Harmening am 16. Sep. 2014 editiert.]

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

---

TESCHT.CATPart

Hallo Thomas, danke dir mal für deinen Beitrag. Das Makro das du ansprichst habe ich mit einem Kollegen zusammen gestrickt, zu der Zeit hatte ich absolut keine Ahnung. Ich hab zwar immer noch keine, aber zumindest eine Anfängerschulung bekommen    . Ich soll Mitarbeiter schulen zwecks Datenaufbereitung, die das nur alle Schaltjahre machen müssen, wenn jemand ausfällt. Die Userforms will ich haben, um es meinen Mitarbeitern so einfach wie möglich zu machen. Deswegen sollte alles so unkompliziert wie möglich sein, was natürlich für mich den Schwierigkeitsgrad erhöht.

Ich habe ein Makro geschrieben, das mir zuerst die Geosets anlegt in denen sich die Elemente befinden. Dann gibt es noch ein Referenzteil wo die Mitarbeiter sich das immer wieder anschauen können. In den Userforms soll dann die Vorselektion stattfinden, denn nicht jedes Teil hat zb. 2 Stöße oder 2 Tragegewinde usw. Im Hintergrund sollte das dann so ablaufen, wenn die Haken gesetzt sind: Per MsgBox die Auforderung was gerade selektiert werden soll, dies wird dann umbenannt, kopiert und ohne Verknüpfung mit Paste Special in den Ordner WorkNC_Input gelegt und das Original ins Hide. Mein Problem ist UserForms dazu zu bringen es zu tun. Userform würde erst in der nächsten Schulung ein Thema werden, ich habe aber nur bis Ende November Zeit, dann gibts wieder Quartalsgespräche und ich bin jetzt schon mit einer roten Ampel versehen.     

Option Explicit
Dim sMacroName As String
Dim sVersion As String
Dim oCATIA As Application
Sub catmain()
'----------------------------------------------------------
    Set oCATIA = CATIA
   

        Dim oDoc As PartDocument
        Set oDoc = oCATIA.ActiveDocument
  
        Dim opart1 As Part
        Set opart1 = oDoc.Part
       

       Dim oSel 'As Selection
       Dim oBody 'As Body
        Set oSel = oCATIA.ActiveDocument.Selection
        oSel.Clear
        Set oBody = oCATIA.ActiveDocument.Part.Bodies.Add()
        oBody.Name = "Rohteil_"
       oSel.Add (oBody)
       oSel.VisProperties.SetRealOpacity 0, 1

'-----------------------------------------------------------------
        Dim hybridBodies1 As HybridBodies
        Set hybridBodies1 = opart1.HybridBodies
        Dim hybridBody1 As HybridBody
        Set hybridBody1 = hybridBodies1.Add()
        hybridBody1.Name = "Aufbau"
        opart1.UpdateObject hybridBody1
'-----------------------------------------------------------------
        Dim hybridBodies2 As HybridBodies
        Set hybridBodies2 = hybridBody1.HybridBodies
        Dim hybridBody2 As HybridBody
        Set hybridBody2 = hybridBodies2.Add()
       hybridBody2.Name = "Geometrie"
       opart1.UpdateObject hybridBody2
'-----------------------------------------------------------------
        Dim hybridBodies3 As HybridBodies
        Set hybridBodies3 = hybridBody2.HybridBodies
        Dim hybridBody3 As HybridBody
        Set hybridBody3 = hybridBodies3.Add()
       hybridBody3.Name = "Hilfselemente (Punkte & Linien)"
       opart1.UpdateObject hybridBody3
'-----------------------------------------------------------------
        Dim hybridBodies4 As HybridBodies
        Set hybridBodies4 = hybridBody2.HybridBodies
        Dim hybridBody4 As HybridBody
        Set hybridBody4 = hybridBodies4.Add()
       hybridBody4.Name = "Flaechen & Ebenen"
       opart1.UpdateObject hybridBody4
'-----------------------------------------------------------------
        Dim hybridBodies5 As HybridBodies
        Set hybridBodies5 = hybridBody2.HybridBodies
        Dim hybridBody5 As HybridBody
        Set hybridBody5 = hybridBodies5.Add()
        hybridBody5.Name = "NCM & 3D Lochinfo"
        opart1.UpdateObject hybridBody5
'-----------------------------------------------------------------
        MsgBox "Der Ordner NCM & 3D Lochinfo bleibt selektiert, Makro ist beendet", 64, "Makro Aufbauordner"
       

End Sub

[Diese Nachricht wurde von ChiefJosef am 17. Sep. 2014 editiert.]

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

---

caddedummy.zip

Eine Userform aufrufen

Code:

---

Sub test()
UF_Publication.Show 'läd die userform UF_Publication
End Sub

---

In deiner Userform die (Auswahl) Commandbuttons sinnvoll beschreiben [hier: c_fla_aussen, c_kon, c_umr (Ausfuehren, Beenden) ]
(wenn geklickt, gibt es den Rückgabewert TRUE, das lässt sich dann auswerten.
Da der Commandbutton gleich sinnvoll benamst wurde hole ich mir auch gleich den Namen davon = bennenung

Ob User die Selection der Elemente davor [Sub Ausfuehren_Click] oder danach mittels einem weiteren Dialog überlasse ich dir ;)

rest is your part.

Code:

---

Sub Ausfuehren_Click()

If c_fla_aussen = True Then benennung = c_fla_aussen.Name
If c_kon = True Then benennung = c_kon.Name
If c_umr = True Then benennung = c_umr.Name

MsgBox "erzeuge Geos für " & benennung

'hier dein Code
'for copy selection and PasteSpecial ("CATPrtResultWithOutLink") '"CATIA_RESULT"
'in deine Geosets

Sub Beenden_Click()
    'UserForm ausblenden
    Me.Hide
  End Sub

---

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

---

Danke dir, ich stelle das Ergebniss hier ein wenn es irgendwann funktioniert wie ich mir das vorstelle. 

------------------
Ich hab keine Ahnung und davon sehr viel.

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

---

Ich bin jetzt ein Stückchen weiter gekommen. Hänge aber bei einem Problem, das Makro gibt mir die Meldung raus dass ich ausserhalb vom Array bin und das verstehe ich nicht. Beim Test als standalone hats funktioniert.

Dann funktioniert es nicht so wie ich es gerne hätte. Eigentlich sollten alle Elemente per Haken ausgewählt werden, dann nach dem OK Butten abgefragt und selektiert. Er springt gleich zur Selektion ohne den OK Button. Da helfen mir meine ganzen schlauen Bücher nichts. Vielleicht kann mir da jemand den ein oder anderen Tip geben und mir etwas auf die Sprünge helfen, habe gerade ein richtiges Brett vor dem Kopf. Danke. Das CatPart ist in den Threads vorher hochgeladen. Hier der derzeitige Code.

Option Explicit
Dim oCATIA As Application
Dim oDoc As PartDocument
Dim partDoc
Dim opart1 As Part
Dim workNC_Input_body As HybridBody
Sub CATMain()
    Set oCATIA = CATIA
       
        Dim Aufbau As HybridBody
        Set oDoc = oCATIA.ActiveDocument
        Set iSel = oCATIA.ActiveDocument.Selection
On Error Resume Next
   
    If Err.Number Then
  'HybridBody erzeugen wenn nicht vorhanden
  'Fehler wird ausgelöst wenn WorkNC_Input nicht vorhanden
        Dim hybridBodies1 As HybridBodies
        Set hybridBodies1 = opart1.HybridBodies
        Dim hybridBody1 As HybridBody
        Set hybridBody1 = hybridBodies1.Add()
        hybridBody1.Name = "WorkNC_Input"
        opart1.UpdateObject hybridBody1
    Err.Clear
  On Error GoTo 0
End If
Set Aufbau = CATIA.ActiveDocument.Part.HybridBodies.Item("Aufbau")
If Err.Number Then
MsgBox ("Ich weiß wo deine Garage parkt"), 64, ("Infobox")
  Exit Sub
  Err.Clear
  End If
  End Sub

 
Private Sub Abbrechen_Click()
Me.Abbrechen.Cancel = True
MsgBox ("Makro wurde abgebrochen"), 64, ("Alzheimer oder was?")
Me.Hide
Exit Sub
End Sub

Private Sub Weiter_Click()
Me.Auswahl_c_fla_aussen = True
If c_fla_aussen = True Then Call Auswahl_c_fla_aussen
End If

'Me.Auswahl_c_flachsenk = True
'Call c_flachsenk
'Me.Auswahl_c_flachsenk_1 = True
'Call c_flachsenk_1
'Me.Auswahl_c_frei = True
'Call c_frei
'Me.Auswahl_c_frei_1 = True
'Call c_frei_1
'Me.Auswahl_c_frei_2 = True
'Call c_frei_2
'Me.Auswahl_c_frei_3 = True
'Call c_frei_3
'Me.Auswahl_c_frei_4 = True
'Call c_frei_4
'Me.Auswahl_c_kon = True
'Call c_kon
'Me.Auswahl_c_nute = True
'Call c_nute
'Me.Auswahl_c_nute_1 = True
'Call c_nute_1
'Me.Auswahl_c_nute_2 = True
'Call c_nute_2
'Me.Auswahl_c_nute_3 = True
'Call c_nute_3
'Me.Auswahl_c_schulter = True
'Call c_schulter
'Me.Auswahl_c_schulter_1 = True
'Call c_schulter_1
'Me.Auswahl_c_schulter_2 = True
'Call c_schulter_2
'Me.Auswahl_c_st_1 = True
'Call c_st_1
'Me.Auswahl_c_st_2 = True
'Call c_st_2
'Me.Auswahl_c_tasche = True
'Call c_tasche
'Me.Auswahl_c_tasche_1 = True
'Call c_tasche_1
'Me.Auswahl_c_tragegew = True
'Call c_tragegew
'Me.Auswahl_c_tragegew_1 = True
'Call c_tragegew_1
'Me.Auswahl_c_umri = True
'Call c_umri
'Me.auswahl_NCM = True
'Call NCM
'Me.Auswahl_Schutzfläche = True
'Call Schutzfläche
'Me.Auswahl_punkt_umri = True
'Call pkt_umri
'Me.Auswahl_punkt_st_1 = True
'Call punkt_st_1
'Me.Auswahl_punkt_st_2 = True
'Call punkt_st_2
'Me.Auswahl_punkt_schulter = True
'Call punkt_schulter
'Me.Auswahl_punkt_flachsenk = True
'Call punkt_flachsenk
'Me.Auswahl_punkt_flachsenk_1 = True
'Call punkt_flachsenk_1
'Me.Auswahl_punkt_tragegew = True
'Call punkt_tragegew
'Me.Auswahl_punkt_tragegew_1 = True
'Call punkt_tragegew_1

End Sub

Private Sub Auswahl_c_fla_aussen_Click()
   
    Dim iSel 'As Selection
    Dim element(1)
    Dim elementNamen
    Dim partDoc, elementTyp
    Set partDoc = CATIA.ActiveDocument.Part
    Set workNC_Input_body = CATIA.ActiveDocument.Part.HybridBodies.Item("WorkNC_Input")
    elementNamen = Array("c_fla_aussen")
    elementTyp = Array()
     
Dim ceLe
Dim addedEle
Dim i
For i = 0 To UBound(elementNamen)
If MsgBox("Wähle " & elementNamen(i), vbYesNo) = vbYes Then
usfSelectElement Array(elementTyp(i)), "Wähle Element " & elementNamen(i), CATIA.ActiveDocument, ceLe
' -------------------
                    iSel.Add ceLe
                    'Debug.Print iSel.Item2(1).name, iSel.Item2(1).Value.name
                    iSel.Item(1).Value.Name = elementNamen(i)
                    iSel.Copy
                    'Debug.Print iSel.Item2(1).name, iSel.Item2(1).Value.name
                    iSel.Clear
                    iSel.Add workNC_Input_body
                    iSel.PasteSpecial ("CATPrtResultWithOutLink") '"CATIA_RESULT"
                   
                    iSel.Clear
                    'partdoc.Update
                    workNC_Input_body.HybridShapes.Item(workNC_Input_body.HybridShapes.Count).Name = elementNamen(i)
                    'Debug.Print workNC_Input_body.HybridShapes.Item(workNC_Input_body.HybridShapes.Count).name
                    partDoc.Update

End If
Next i
Exit Sub
cerror:
End Sub
Private Function usfSelectElement(element, message, currentDoc, setValue)
    Dim userSel
    Set userSel = currentDoc.Selection
    userSel.Clear
    Dim selState
    selState = userSel.SelectElement2(element, message, False)
    If (selState = "ok" Or selState = "Normal") Then
        Set setValue = userSel.Item(1).Value
    End If
End Function
Private Function addHybridBodie(cName, addedBodie, currBodies As HybridBodies)
    Set addedBodie = currBodies.Add
        addedBodie.Name = cName
        currentPart.Update
End Function

------------------
Ich hab keine Ahnung und davon sehr viel.

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

---

Servus
Wo läuft der Array außerhalb des gültigen Bereich? Zu welcher Selektion wird gesprungen? In welcher Sub?
Ich hab keine Zeit für Suchspiele in einem langen Code nach einem Fehler, ein Eingrenzung wäre sehr sinnvoll.
Ich sehen nichts von irgendwelchen Controls (Listbox, Checkbox, ...). Wo wird dieser Status in deinem Makro abgefragt?

Gruß
Bernd

PS: Bitte Code besser strukturieren und in [Code]-Tags posten

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

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

---

Danke für die Antwort, du hast mich schon auf den ersten Fehler aufmerksam gemacht, DAS ist die Userform. Deswegen kein Aufruf, dann darf wenn ich das richtig verstehe in der Userform kein Code drin sein. Ich bin also schon am Grundaufbau gescheitert. Denke ich sollte irgendwie jemanden finden der einem die Grundzüge beibringt, ich habe leider kein Catia Zuhause, dass ich mich mal einarbeiten könnte, so läuft das neben dem Tagesgeschäft, immer ein paar Schnipsel, dann mal eine Woche nichts. Im Buch ist nichts zu finden was den Aufbau betrifft. Ich hatte ja erwähnt, dass ich in der Userform blutiger Anfänger bin. Was meinst du mit strukturieren und Code Tags? Bin vielleicht doch zu alt für den ****** 
Gruß Ralf

PS.:If c_umr = True Then benennung = c_umr.Name, das hat auch nicht funktioniert, er kennt das Wort bennenung nicht

------------------
Ich hab keine Ahnung und davon sehr viel.

[Diese Nachricht wurde von ChiefJosef am 23. Okt. 2014 editiert.]

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

---

Servus
Der Code darf schon in der Userform drin stehen.
ggf solltest du dich erst in VBA grundlegend einarbeiten. Da sollte es genügend Tutorials/Literatur geben (im speziellen für Excel, vermutlich wird da mehr auf die Userforms eingegangen)

Gruß
Bernd

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

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

---

Menue_Standard.jpg

Wie versprochen hier der VB Code der Userform:

Option Explicit

Private Sub Abbrechen_Click()
SchleifeAbbrechen = True
MsgBox ("Makro wurde abgebrochen"), 64, ("Alzheimer oder was?")
Me.Hide

DoEvents
'SendKeys "{ESC}", True
Call keybd_event(VK_TAB, 0, 0, 0)
Call keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(VK_ESCAPE, 0, 0, 0)
Call keybd_event(VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0)

End Sub

Private Sub c_fla_aussen_Click()

End Sub

Private Sub cbAlleAbWaehlen_Click()
Dim i As Long
Dim o As Object

For i = 0 To Me.Controls.Count - 1
    Set o = Me.Controls.Item(i)
    If TypeName(o) = "CheckBox" Then o.Value = 0
Next i

End Sub

Private Sub cbAlleWaehlen_Click()
Dim i As Long
Dim o As Object

For i = 0 To Me.Controls.Count - 1
    Set o = Me.Controls.Item(i)
    If TypeName(o) = "CheckBox" Then o.Value = 1
Next i

End Sub

Private Sub fla_off_1_Click()

End Sub

Private Sub pkt_umri_Click()

End Sub

Private Sub Weiter_Click()
Dim Meldung As Boolean
Dim Farbe As Long
Dim SelFilter()  As Variant
Dim Hilfe() As String
Dim sStatus  As String
Dim hs As HybridShape
Dim i As Long
Dim x As Integer
Dim ChkB As Object

Sel.Add workNC_Input_body
Sel.VisProperties.SetShow catVisPropertyNoShowAttr
Me.Weiter.Enabled = False
Me.cbAlleWaehlen.Enabled = False
Me.cbAlleAbWaehlen.Enabled = False

For i = 0 To Me.Controls.Count - 1 ' Schleife über alle Elemente in der UserForm um nachträgliches ändern zu verhindern
    Set ChkB = Me.Controls.Item(i)
    If TypeName(ChkB) = "CheckBox" Then ChkB.Locked = True
Next i

For i = 0 To Me.Controls.Count - 1 ' Schleife über alle Elemente in der UserForm

If SchleifeAbbrechen Then Exit For ' bei Abbruch Schleife verlassen

    Set ChkB = Me.Controls.Item(i)
    If TypeName(ChkB) = "CheckBox" Then  ' Element vom Typ Checkbox
       
        If ChkB.Value Then
            ChkB.Font.Bold = True
            Farbe = ChkB.BackColor
            ChkB.BackColor = RGB(256, 125, 0)
           
            If Meldung = False Then ' Einmalige Meldung am Anfang, nur bei 1. Selektierter Checkbox
                Meldung = True
                MsgBox "Bitte die im Fenster hervorgehobenen Elemente wählen." & Chr(13) & "Siehe auch unten in der Statusleiste.", vbOKOnly + vbInformation, "Elemente wählen"
            End If
           
            'Hilfskonstrukion um den "Typ" des zu wählenden Elements an die Auswahl zu übergeben
            'Die Information welcher "Typ", steckt in jeder Checkbox selbst, und zwar
            'unter der Eigenschaft .Tag. (Dies ist eine Eigenschaft, die jedes Element besitzt,
            'und zur freien Verfügung ist.
            Hilfe() = Split(ChkB.Tag, ",")  'Dies hier ist eine "Krücke" um mehrere Typen Auswählen zu können
            ReDim SelFilter(UBound(Hilfe)) ' Siehe 1. Checkbox "Schutz"
            For x = 0 To UBound(Hilfe)
                SelFilter(x) = Trim(Hilfe(x))
            Next x
            sStatus = Sel.SelectElement2(SelFilter, "Bitte wählen Sie: " & ChkB.Tag & " ESC=Abbrechen", False)
            If sStatus <> "Cancel" Then ' Wenn Auswahl nicht abgebrochen
                Sel.Copy
                Sel.VisProperties.SetShow catVisPropertyNoShowAttr
                Sel.Clear
                Sel.Add workNC_Input_body
                Sel.PasteSpecial ("CATPrtResultWithOutLink") '"CATIA_RESULT"
               
                'Farbe und Transparenz einstellen
                If ChkB.Caption = "Schutz" Then
                    Sel.VisProperties.SetRealColor 0, 175, 175, 0
                    Sel.VisProperties.SetRealOpacity 255 / 100 * 25, 0
                'Schutzfläche für Aufspannplatten Z3mm von Sohle
                End If
                If ChkB.Caption = "fla_off_*1" Then
                    Sel.VisProperties.SetRealColor 0, 127, 255, 0
                End If
                If ChkB.Caption = "fla_off_*2" Then
                    Sel.VisProperties.SetRealColor 95, 0, 95, 0
                End If
                If ChkB.Caption = "fla_off_*3" Then
                    Sel.VisProperties.SetRealColor 0, 128, 0, 0
                End If
                If ChkB.Caption = "fla_frei" Then
                    Sel.VisProperties.SetRealColor 95, 0, 0, 0
                    Sel.VisProperties.SetRealOpacity 255 / 100 * 75, 0
                End If
                If ChkB.Caption = "fla_frei_1" Then
                    Sel.VisProperties.SetRealColor 95, 0, 0, 0
                    Sel.VisProperties.SetRealOpacity 255 / 100 * 75, 0
                End If
                If ChkB.Caption = "fla_frei_2" Then
                    Sel.VisProperties.SetRealColor 95, 0, 0, 0
                    Sel.VisProperties.SetRealOpacity 255 / 100 * 75, 0
                End If
                If ChkB.Caption = "fla_frei_3" Then
                    Sel.VisProperties.SetRealColor 95, 0, 0, 0
                    Sel.VisProperties.SetRealOpacity 255 / 100 * 75, 0
                End If
                If ChkB.Caption = "fla_frei_4" Then
                    Sel.VisProperties.SetRealColor 95, 0, 0, 0
                    Sel.VisProperties.SetRealOpacity 255 / 100 * 75, 0
                End If
                If ChkB.Caption = "Deckel" Then
                    Sel.VisProperties.SetRealColor 95, 0, 0, 0
                    Sel.VisProperties.SetRealOpacity 255 / 100 * 50, 0
                'Schliessen von Durchbrüchen
                End If
                If ChkB.Caption = "Kollisionsfläche" Then
                    Sel.VisProperties.SetRealColor 255, 0, 0, 0
                    'Sel.VisProperties.SetRealOpacity 255 / 100 * 50, 0
                'Kollisionsvermeidung, Verletzung von Übergängen, Schutzflächen
                End If
               
                Sel.Clear
                workNC_Input_body.HybridShapes.Item(workNC_Input_body.HybridShapes.Count).Name = ChkB.Name
                'workNC_Input_body.HybridShapes.Item(workNC_Input_body.HybridShapes.Count)
                oPart.Update
               
            End If
       
            ChkB.BackColor = Farbe
            ChkB.Font.Bold = False
        End If
    End If
Next i
Sel.Add workNC_Input_body
Sel.VisProperties.SetShow catVisPropertyShowAttr

Me.Weiter.Enabled = True
Me.cbAlleWaehlen.Enabled = True
Me.cbAlleAbWaehlen.Enabled = True

For i = 0 To Me.Controls.Count - 1 ' Schleife über alle Elemente in der UserForm
    Set ChkB = Me.Controls.Item(i)
    If TypeName(ChkB) = "CheckBox" Then ChkB.Locked = False
Next i

Me.Hide

End Sub

und hier der Code des eigentlichen Macros:

Option Explicit
Public Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_ESCAPE = &H1B
Public Const VK_TAB = &H9

Public Sel As Object ' Selection
Public oPart As Part
Public workNC_Input_body As HybridBody
Public SchleifeAbbrechen As Boolean

Public Sub CATMain()
Dim l As Single
Dim t As Single
If CATIA.Documents.Count Then            ' Püfen ob eine Datei geöffnet
    If CATIA.Windows.Count Then          ' Püfen ob ein Fenster angezeigt wird
        If TypeName(CATIA.ActiveWindow) <> "Window" Then         
            If TypeName(CATIA.ActiveDocument) = "PartDocument" Then ' Prüfen ob actives Dokument ein Produkt ist
   
                Set Sel = CATIA.ActiveDocument.Selection
                Set oPart = CATIA.ActiveDocument.Part
                Sel.Clear
               
                If ExistGeoSet("Aufbau", oPart) = False Then
                    MsgBox "Das GeoSet ""Aufbau"" existiert nicht! Abbruch", vbOKOnly + vbInformation
                    Exit Sub
                End If
               
                If ExistGeoSet("WorkNC_Input", oPart, workNC_Input_body) = False Then
                    Set workNC_Input_body = oPart.HybridBodies.Add()
                    workNC_Input_body.Name = "WorkNC_Input"
                End If
               
                ' hier der UserForm Aufruf
                If UserForm2 Is Nothing Then Load UserForm2
                l = CATIA.Left + CATIA.Width / 2 '- fZangen_an_Punkt.Width / 2
                t = CATIA.Top
                If t <= 0 Then t = 0 + 1
                If l <= 0 Then l = 0
                UserForm2.Left = l
                UserForm2.Top = t
               
                SchleifeAbbrechen = False
                UserForm2.Show vbModeless
                               
            Else
                CATIA.StatusBar = "Aktive Datei ist kein Part"
            End If
        Else
            CATIA.StatusBar = "Aktives Dokument ist keine 3D-Datei." 'der Schreibtisch"
        End If
    Else
        CATIA.StatusBar = "Kein Dokument geladen"
    End If
Else
    CATIA.StatusBar = "Kein Dokument geladen"
End If
End Sub

Public Function ExistGeoSet(Name As String, Part As Part, Optional ByRef GeoSet As HybridBody) As Boolean
On Error GoTo fehler:
Set GeoSet = Part.HybridBodies.Item(Name)
ExistGeoSet = True
fehler:

End Function

------------------
Ich hab keine Ahnung und davon sehr viel.

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

---

Hallo Chief,

das sieht VB-technisch schon ganz gut aus.
Was ich Dir noch nahe legen möchte ist, Deinen Kode zu kommentieren.
Sonst weisst in einem halben Jahr nicht mehr warum, wieso etc. .

Auch kann ich die MZTools empfehlen.

http://www.mztools.com/index.aspx

Tschau,
Joe

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

---

Danke für den Tip, lässt sich leider ohne Adminrechte nicht installieren.
In meiner Version sind die Kommentare drin.
Ich habe sie nur zur Veröffentlichung gelöscht um niemand in Verwirrung zu stürzen. 
Ohne Profihilfe wäre ich auch nicht soweit gekommen, nichtmal ansatzweise.
Dafür war die Grundschulung nicht tief genug.

------------------
Ich hab keine Ahnung und davon sehr viel.

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