---

Hallo,

Ich habe mir ein Marko, das ich aus dem Netz habe für meine Bedürfnisse angepasst.
Dies funktioniert soweit.

Es werden diverse Werte aus einem Excelsheet zu Catia in ein ParamSet übertragen.

Nun Möchte ich eine Selection des entsptrechenden Produktes vornehmen.

Dazu habe ich versucht den Code von joehz (hier)ein zu binden.

Code:

---

Option ExplicitSub CATMain2()
  MsgBox "The selected object is: " & GetProduct.Name
End Sub

Function GetProduct() As Variant
  Dim oSel 'As Selection
  Dim arrSelWhich(1)
  Dim Status As String

  Set oSel = CATIA.ActiveDocument.Selection
  oSel.Clear

  arrSelWhich(0) = "Part"                      'needs to be part first?!
  arrSelWhich(1) = "Product"                  'otherwise only products will be allowed

  Status = oSel.SelectElement2(arrSelWhich, "Select Part or Product", False)

  If (Status = "Normal") Then
      Set GetProduct = oSel.Item2(1).Value
  End If
  oSel.Clear

End Function

---

Leider ohne Erfolg.

Hat jemand eine Tip für mich.

Code:

---

Option Explicit
Dim wksTab As Worksheet

Private Sub Infoparam2Catia_Click()
'Infoparam2Catia_1_1

On Error Resume Next
Dim iCATIA
Set iCATIA = CreateObject("CATIA.Application")
'iCATIA.Visible = True
Dim ierr
ierr = Err.Number
On Error GoTo 0
If ierr Then
    MsgBox "Bitte öffnen sie Catia und das entsprechende Produkt" & Chr(10) & Chr(10) & "Um die Projektinfoparameter zu übertragen, muss Catia sowie das Hauptprodukt geöffnet sein!"
    Exit Sub
End If

On Error Resume Next
'Set iPart = iCATIA.ActiveDocument.Part
Dim iProduct
Set iProduct = iCATIA.ActiveDocument.Product
Dim Kerr
Kerr = Err.Number
On Error GoTo 0
If Kerr Then
  MsgBox "Es ist kein Produkt geöffnet!" & Chr(10) & Chr(10) & "Bitte das Produkt mit den Projektinfoparametern öffnen !"
  Exit Sub
End If

On Error Resume Next
Dim iSet1
Set iSet1 = iProduct.Parameters.RootParameterSet.ParameterSets.Item("Projektinfo")
Dim ferr
ferr = Err.Number
On Error GoTo 0
If ferr Then
    MsgBox "Beim geöffneten Catiadokument handelt es sich nicht um das Hauptprodukt mit den Projektinfoparametern" & Chr(10) & Chr(10) & "Bitte das Produkt mit den Projektinfoparametern öffnen, oder die Parameter erzeugen!"
    Exit Sub
End If

Dim AllParameters
Set AllParameters = iProduct.Parameters
Dim Feld(110)
Dim mi
mi = iProduct.Name

Set Feld(0) = AllParameters.Item(mi & "\Projektinfo\KUNDE")
Set Feld(1) = AllParameters.Item(mi & "\Projektinfo\PROJEKTNUMMER")
Set Feld(2) = AllParameters.Item(mi & "\Projektinfo\BAUTEIL_NR")
Set Feld(3) = AllParameters.Item(mi & "\Projektinfo\BAUTEILNAME")
Set Feld(4) = AllParameters.Item(mi & "\Projektinfo\DATENEINGANGS_NR")
Set Feld(5) = AllParameters.Item(mi & "\Projektinfo\MATERIAL")
Set Feld(6) = AllParameters.Item(mi & "\Projektinfo\MAT_DICKE")
Set Feld(7) = AllParameters.Item(mi & "\Projektinfo\PRODUKTIONSPRESSE")

Feld(0).Value = Range("Kunde").Value
Feld(1).Value = Range("Projektnummer").Value
Feld(2).Value = Range("Bauteil_Nr").Value
Feld(3).Value = Range("Bauteilname").Value
Feld(4).Value = Range("DateneingangsNr").Value
Feld(5).Value = Range("Material").Value
Feld(6).Value = Range("Mat_Dicke").Value
Feld(7).Value = Range("Pr_Auswahl").Value

MsgBox "Parameter aus Excel wurden auf CATIA Parameter übertragen!"
iProduct.Update
End Sub

---

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

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

---

Servus Uwe
Wo scheitert dein Vorgehen? Kommt eine Fehlermeldung? Was hast du schon probiert?
Wenn du der Funktion "GetProduct" noch die Catia-Applictaion als Parameter übergibst könnte es schon (fast) funktionieren.

Gruß
Bernd

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

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

---

Hi Uwe,

ich hab auch noch n Bisschen damit gespielt.
Die Cruz ist der Workmodus.
Ergänzt und erweitert sieht die Routine so aus:

Code:

---

Sub CATMain()
  If CATIA.Documents.Count > 0 Then
      MsgBox "The selected doc is: " & GetSelDoc.Name
  End If
End Sub

'---------------------------------------------------------------------------------------
' Procedure : GetSelDoc
' Author    : jherzog
' Date      : 28.10.2015
' Time      : 16:05
' Languages : VBA 6.5
' V5-Release: V5R19/21
' Purpose  : Interactivly select a document(product, part or drawing)
' Parms    : -
' Ret. Value: the selected doc object
'
' Syntax    : GetSelDoc
'
' Prereqs  : an open doc
' Remarks  : -
'---------------------------------------------------------------------------------------
'
Function GetSelDoc() As Variant
  Dim oSel                                                'As Selection
  Dim arrSelWhich(2)
  Dim Status As String
  Dim oPP
  Dim i As Integer
 
  On Error GoTo GetSelDoc_Error

  For i = 1 To CATIA.Documents.Count
      CATIA.Documents.Item(i).Product.ApplyWorkMode (DEFAULT_MODE)  'set work mode
      DoEvents
  Next

  Set oSel = CATIA.ActiveDocument.Selection
  oSel.Clear

  arrSelWhich(0) = "Part"                                'needs to be part first?!
  arrSelWhich(1) = "Product"                              'otherwise only products will be allowed
  arrSelWhich(2) = "DrawingRoot"

  Status = oSel.SelectElement2(arrSelWhich, "Select Part, Product or Drawing", False)

  If (Status = "Normal") Then
      Set oPP = oSel.Item2(1)
      Select Case oPP.Type
        Case "Part"
            Set GetSelDoc = oPP.Value.Parent
        Case "Product"
            Set GetSelDoc = oPP.Value.ReferenceProduct.Parent
        Case "DrawingRoot"
            Set GetSelDoc = oPP.Document
      End Select

  End If
  oSel.Clear

Exit Function
'---------------------------------------------------------------------------------------
GetSelDoc_Error:
  Dim errMsg As String
  Dim errRet As VbMsgBoxResult

  Select Case Err.Number
      Case 438        'ApplyWorkMode causes error if already set
        Resume Next
'      Case -2147467259
      Case Else
        errMsg = Err.Number & ": " & Err.Description & " in procedure GetSelDoc"
        errRet = MsgBox(errMsg, vbOKOnly, "GetSelDoc")
  End Select

  'Resume Next                                          'fall thru to quit sub
'---------------------------------------------------------------------------------------
End Function

---

Zurückgeliefert wird ein Document; Part, Product oder Drawing.

Tschau,
Joe

PS: Ich schreib den Artikel noch entsprechend um.

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

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