---

Eigenschaftenanlegen.zip

Hallo liebe CAD-Community,
ich habe ein Problem mit einem eigentlich simplen Makro.
Das Makro verknüpft Parameter mit Formeln und legt diese als Eigenschaften an.
Die Parameter werden von unserem Stücklisten Programm angelegt (Unipartlist).
Ich finde allerdings keinen Ansatz zu verhindern das die Eigenschaften doppelt angelegt werden.
Also jedes mal wenn das Makro gestartet wird werden die Eigenschaften immer wieder angelegt.
Hat jemand vielleicht eine Lösung?

Vielen Dank!

Language="VBSCRIPT"

Sub CATMain()

'--------------Part Selektieren-----------

'Dim UserSelektion As Selection
'Set  UserSelektion = CATIA.ActiveDocument.Selection

'Name = (UserSelektion.Item(1).Value.ReferenceProduct.Name)

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = PartDocument1.Part

Dim parameters1 As Parameters
Set parameters1 = part1.Parameters

'Dim strParam1 As StrParam
'Set strParam1 = parameters1.CreateString("", "")

'strParam1.Rename "Dimension"

'strParam1.Value = "xxx"

part1.Update

Dim product1 As CATBaseDispatch
Set product1 = partDocument1.GetItem("Name")

'++++++++++++++++++Eigenschaften anlegen++++++++++++++++

Dim parameters9 As Parameters
Set parameters9 = product1.UserRefProperties

Dim strParam9 As StrParam
Set strParam9 = parameters9.CreateString("Position", "")

strParam9.ValuateFromString "xxx"

Dim parameters2 As Parameters
Set parameters2 = product1.UserRefProperties

Dim strParam2 As StrParam
Set strParam2 = parameters2.CreateString("CAD Material", "")

strParam2.ValuateFromString "xxx"

Dim parameters10 As Parameters
Set parameters10 = product1.UserRefProperties

Dim strParam10 As StrParameters
Set StrParam10 = parameters10.CreateString("Masse", "")

strParam10.ValuateFromString "0kg"

Dim parameters4 As Parameters
Set parameters4 = product1.UserRefProperties

Dim strParam3 As StrParam
Set strParam3 = parameters4.CreateString("Dimension", "")

strParam3.ValuateFromString "xxx"

Dim parameters5 As Parameters
Set parameters5 = product1.UserRefProperties

Dim strParam5 As StrParam
Set strParam5 = parameters5.CreateString("Lieferant", "")

strParam5.ValuateFromString "xxx"

Dim parameters6 As Parameters
Set parameters6 = product1.UserRefProperties

Dim strParam6 As StrParam
Set strParam6 = parameters6.CreateString("Status", "")

strParam6.ValuateFromString "xxx"

Dim parameters7 As Parameters
Set parameters7 = product1.UserRefProperties

Dim strParam7 As StrParam
Set strParam7 = parameters7.CreateString("Ersatzteil", "")

strParam7.ValuateFromString "xxx"

Dim parameters8 As Parameters
Set parameters8 = product1.UserRefProperties

Dim strParam8 As StrParam
Set strParam8 = parameters8.CreateString("Bestellstatus", "")

strParam8.ValuateFromString "xxx"

Set product1 = product1.ReferenceProduct

'++++++++++++++++++Formeln anlegen++++++++++++++++

Dim relations1 As Relations
Set relations1 = part1.Relations

Dim formula1 As Formula
Set formula1 = relations1.CreateFormula("Formel.1", "", strParam2, "Material ")

formula1.Rename "Formel.1"

Dim relations2 As Relations
Set relations2 = part1.Relations

Dim formula2 As Formula
Set formula2 = relations2.CreateFormula("Formel.2", "", strParam10, "Stueckliste\Weight")

formula2.Rename "Formel.2"

Dim relations3 As Relations
Set relations3 = part1.Relations

Dim formula3 As Formula
Set formula3 = relations3.CreateFormula("Formel.3", "", strParam3, "Stueckliste\Dimension")

formula3.Rename "Formel.3"

Dim relations5 As Relations
Set relations5 = part1.Relations

Dim formula5 As Formula
Set formula5 = relations5.CreateFormula("Formel.5", "", strParam5, "Stueckliste\Lieferant")

formula5.Rename "Formel.5"

Dim relations6 As Relations
Set relations6 = part1.Relations

Dim formula6 As Formula
Set formula6 = relations6.CreateFormula("Formel.6", "", strParam6, "Stueckliste\Status")

formula6.Rename "Formel.6"

Dim relations7 As Relations
Set relations7 = part1.Relations

Dim formula7 As Formula
Set formula7 = relations7.CreateFormula("Formel.7", "", strParam7, "Stueckliste\Ersatzteil")

formula7.Rename "Formel.7"

Dim relations8 As Relations
Set relations8 = part1.Relations

Dim formula8 As Formula
Set formula8 = relations8.CreateFormula("Formel.8", "", strParam8, "Stueckliste\Bestellstatus")

formula8.Rename "Formel.8"

Dim relations9 As Relations
Set relations9 = part1.Relations

Dim formula9 As Formula
Set formula9 = relations9.CreateFormula("Formel.9", "", strParam9, "Stueckliste\Position")

formula9.Rename "Formel.9"

part1.Update

MsgBox ("Eigenschaften wurden angelegt")

End Sub

------------------
Gruß
EckBonito

[Diese Nachricht wurde von EckBonito am 13. Mrz. 2023 editiert.]

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

---

Eine Möglichkeit ist, die Eigenschaft anzusprechen, bevor sie erzeugt wird.
Wenn das geklappt hat, ist sie vorhanden.

DummyCode:
On Error resume Next' Makro läuft bei Fehlern weiter
Eigenschaft.Value = "Sollwert" 'Wenn Eigneschaft vorhanden, wird sie befüllt. Ansonsten gibt es einen Fehler, der verworfen wird.
On Error Go to 0 ' Makro steigt bei Fehlern aus
If Eigenschaft.VAlue <> "Sollwert" Then
Eigenschaft erzeugen und befüllen.
End If

Würdest du Makros-Quelltext bitte posten. Anhänge lassen sich nicht mit der Suche finden.

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

---

Ich hab versucht deinen Ansatz
zu nutzen, bekomme es aber nicht wirklich zum laufen.

Könntest du mir noch einen Tipp geben welchen
Wert ich als Eigenschaft nehmen müsste?

Danke

------------------
Gruß
EckBonito

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

---

Servus

Hier findest du eine kleines Beispiel mit einer extra Unterroutine, wie man man prüfen kann ob es solch einen UserProperty gibt.
Die Option, falls nicht vorhanden den Parameter zu erzeugen fehlt noch.

Gruß
Bernd

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

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

---

Vielen Dank für den Link.
Meine Kenntnisse in der Programmierung reichen
aber anscheinend nicht aus, um daraus etwas gescheites zu bauen.
Es bricht immer bei der Function ab.

Könntest du mir vielleicth einen Tip geben,bezogen auf mein Makro?

Vielen Dank!

------------------
Gruß
EckBonito

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

---

Servus

Anbei ein Beispiel wie ich das angehen würde.

Code:

---

Sub CATMain()

Dim oProduct As Product
Dim oUserProperties as Parameters
Dim oUserProperty as Parameter
Dim oRelation as Releation
Dim sUserPropertyName as String
Dim sPathToParameter as String
Dim oPart as Part

On Error Resume Next
Set oProduct = CATIA.ActiveDocument.Product

If (oProduct Is Nothing) Then
    MsgBox "Source Part document not found!", vbCritical
    Exit Sub
End If
On Error GoTo 0

Set oPart = CATIA.ActiveDocument.Part
Set oUserProperties = oProduct.UserRefProperties

sUserPropertyName = "Dimension"
sPathToParameter  = "Stueckliste\Dimension"

Set oUserProperty = getOrCreateProperty(oUserProperties, sUserPropertyName)
Set oRelation = oUserProperty.OptionalRelation

'if realation does not exist, create one
if oUserProperty.OptionalRelation is Nothing then
  Set oRelation = oPart.Relations.CreateFormula("","",oUserProperty,sPathToParameter)
end if

End Sub

Function getOrCreateProperty(UserProperties As Parameters, ParameterName As String) As Parameter
'returns a userproperty by name. If paramter does not exist, function creates a sting parameter

Dim I As Integer

For I = 1 To UserProperties.Count
    If Right(UserProperties.Item(I).Name, Len(ParameterName)) = ParameterName Then
        Set getOrCreateProperty = UserProperties.Item(I)
        Exit Function
    End If
Next

Set getOrCreateProperty = UserProperties.CreateString(ParameterName,"")

End Function

---

Was noch fehlt ist zu testen ob es den Parameter im Parameterset "Stueckliste" überhaupt gibt.
Ich würde mir wohl eine Liste/Array/... erstellen und dort die Parameter und Formeln ablegen. Diese dann einfach per Schleife abarbeiten.
Viel Spaß beim analysieren des Codes

Gruß
Bernd

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

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

---

Hallo zusammen,
was auch geht ist mit dem "ModelElement" zu arbeiten.

Code:

---

Function getOrCreateProperty(UserProperties As Parameters, ParameterName As String) As Parameter
'returns a userproperty by name. If paramter does not exist, function creates a sting parameter

    Dim I As Integer
    Dim Param as Parameter
    Dim ModElem as ModelElement

    For each Param in UserProperties
        Set ModElem = Param.GetItem("ModelElement")
        If ModElem.InternalName = ParameterName Then
            Set getOrCreateProperty = Param
            Exit Function
        End If
    Next

    Set getOrCreateProperty = UserProperties.CreateString(ParameterName,"")

End Function

---

Sollte es mit ModElem.InternalName nicht gehen, mal mit ModElem.DisplayName versuchen.(sitze gerade nicht vor Catia)

Gruß Randle

------------------
Planung ersetzt Fehler durch Irrtum!

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