---

Hallo Leute 
ich habe ein Problem. Ich will mit VBA in Catia ein Kreismuster erzeugen, welches mir unterschiedliche Winkel erlaubt. Soweit so gut. Das funktioniert auch. Allerdings wollte ich nun Parameter erstellen und die Winkel über eine Formel mit den Parametern gleichsetzten. Leider funktioniert das nur Pfadabhängig und das wollte ich wegbekommen.

Code:

---

Dim relations1 As Relations
Set relations1 = part1.Relations

Dim parameters1 As Parameters
Set parameters1 = part1.Parameters

'Wegbekommen will ich hier den Pfad, da wenn ein Part nicht part1 heißt funktioniert das ganze ja nicht mehr
Dim angle1 As angle
Set angle1 = parameters1.Item("Part1\Hauptkörper\Kreismuster.1\PatternSpacing.1\InstanceSpacing")

Dim formula1 As Formula
Set formula1 = relations1.CreateFormula("Formel.7", "", angle1, "`Winkel1` ")

---

Ich hoffe ihr könnt mir helfen.
Vielen Dank schonmal für euere Bemühungen
weylin

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

---

CREATE_CIRCULER-PATTERN_VBA.zip

Hallo weylin,

du schreibst, dass du das Kreismuster innerhalb des Codes erzeugst. Dann kannst du dieses Objekt ja auch weiterverwenden und brauchst keinen statischen String erstellen. Ich habe dir mal ein Beispiel gemacht.

Anmerkung: Innerhalb meines Codes sind auch statische Strings vorhanden (z.B. Name des geometrischen Sets und der Referenzachse). Diese musst du übergeben. Wenn du das nicht willst kannst du auch mit einer interaktiven Selektion (Stichwort: SelectElement2) arbeiten. Falls die Erstellung der Muster im Batchmodus, voll automatisch gehen soll, muss du dir überlegen wie du sicherstellst das in jedem Part die Referenzachse, das zu musternde Objekt, etc. die selben Namen (statischer String) haben.

Im Anhang findest du das Modul (*.bas -> Im Editor -> File -> Import -> Datei auswählen) sowie meine Testdatei (CATPart in R19 erstellt)

------------------
MFG Daniel

Systeminformation | Inoffizielle CATIA Hilfeseite | CATIA FAQ | Suche | TraceParts (Normteile...) | 3D Content Central (noch mehr Normteile...)

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

---

Hallo DanielFr.
vielen Danke erstmal für deine Hilfe. Ich hab versucht mit Hilfe deines Codes meinen zu Verbessern. Leider funktioniert das noch nicht.
Noch ein paar Hintergrundinformationen:
Ich erstelle nach der Eingabe einer Anzahl in eine Textbox dynamisch (je nach Wert der Anzahl) neue Textboxen. In diese dynamisch erstellten Textboxen will ich unterschiedliche Winkel eingeben, damit in deiner Datei, die Bohrungen beliebig unterschiedliche WInkel haben.
Das funktioniert wie gesagt auch schon nur mit den Parametern und den Formeln habe ich noch probleme.
Ich habe deinen Code mal ein wenig umgeschrieben, so wie ich dachte es könnte funktionieren. Tut es aber leider nicht.

Code:

---

  '***DEKLARATIONEN
    Dim intPartDocObj As PartDocument
    Dim intPartObj As Part
    Dim intShapeFacObj As ShapeFactory
    Dim intRef1Obj As Reference
    Dim intRef2Obj As Reference
    Dim intCircPattObj As circpattern
    Dim intBodyObj As Body
    Dim intHybBodiesObj As HybridBodies
    Dim intHybBody As HybridBody
    Dim intHypShapesObj As HybridShapes
    Dim intAxisObj As HybridShapeAxisLine
    Dim intRef3Obj As Reference
    Dim intShapesObj As Shapes
    Dim intObjToPattObj As Pocket
    Dim intRelsObj As Relations
    Dim intParametersObj As Parameters
    Dim intAngleObj() As Angle
    Dim intFormulaObj As Formula

    '***INSTANZIERUNGEN
    Set intPartDocObj = CATIA.ActiveDocument
    Set intPartObj = intPartDocObj.Part
    Set intShapeFacObj = intPartObj.ShapeFactory
    Set intBodyObj = intPartObj.MainBody
    Set intHybBodiesObj = intBodyObj.HybridBodies
    Set intHybBody = intHybBodiesObj.Item("HILFSGEO")
    Set intHypShapesObj = intHybBody.HybridShapes
    Set intAxisObj = intHypShapesObj.Item("Achse.1") 'musste ich ändern, in Datei ist es Axis.1   
    Set intShapesObj = intBodyObj.Shapes
    Set intObjToPattObj = intShapesObj.Item("Pocket.1")
    Set intRelsObj = intPartObj.Relations
   
    '***REFRENZEN FUER PATTERN
    Set intRef1Obj = intPartObj.CreateReferenceFromName("")
    Set intRef2Obj = intPartObj.CreateReferenceFromName("")
    Set intRef3Obj = intPartObj.CreateReferenceFromObject(intAxisObj)
   
   
    '***PATTERN ERSTELLEN
    Set intCircPattObj = intShapeFacObj.AddNewCircPattern(Nothing, 1, 2, 20#, 45#, 1, 1, intRef1Obj, intRef2Obj, True, 0#, True)
    intCircPattObj.CircularPatternParameters = catUnequalAngularSpacing
    intCircPattObj.SetUnequalInstanceNumber TextBox1.Value
    intCircPattObj.ItemToCopy = intObjToPattObj
    intCircPattObj.SetRotationAxis intRef3Obj
   
'Schleife zur erstellung der unterschiedlichen Winkel   
  Dim i As Integer
  i = 2
  Do
  intCircPattObj.SetInstanceAngularSpacing i, Me.Controls("meinetextbox" & (i)).Text
 
  '***PARAMETER ZUWEISEN
'HIer sagt er Objekt unterstützt diese Methode oder EIgenschaft nicht
  Set intAngleObj(i) = intCircPattObj.AngularRepartition.AngularSpacing(i)
  Set intFormulaObj = intRelsObj.CreateFormula("Formula." & 3 + i, "", intAngleObj(i), "WINKEL_BEFESTIGUNGEN__" & i)
     
  i = i + 1
 
  Loop Until (i > TextBox1.Value)
 
    '***PART UPDATEN
    intPartObj.Update
   
    '***AUSGABE
    MsgBox "Makro erfolgreich beendet", vbInformation, "HINWEIS"

---

Ich hoffe Ihr könnt mir Helfen
Vielen Dank schonmal im Vorraus für Euere Bemühungen

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

---

Servus
Musst du vielleicht die Methode "SetInstanceAngularSpacing" verwenden?
"AngularRepartition" ist gemäß Doku nur zum auslesen (read only)

Gruß
Bernd

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

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

---

@bgrittmann
danke erstmal für deine Antwort.
Ich denke allerdings, dass das auslesen reicht. "SetInstanceAngularSpacing" habe ich ja ein paar Zeilen darüber und damit erstelle ich ja das Kreismuster. Wenn ich das nochmal schreibe erstellt sich ein 2. Kreismuster.

Neuer Stand:
Mit dem Code unten funktioniert es jetzt zumindest bei einem Winkel.
Im Formeleditor wird klar, wo der Fehler liegt.

Die "PatternSpacing" (Kreis) müsste er weiter zählen und die Formeln (Pfeil) dann jeweils in die entsprechenden Zeilen schreiben.

Nur wie ist mir nicht klar. Hab schon ein wenig rumprobiert nur leider ohne Erfolg.
Wie kann ich diese PatternSpacing weiterzählenlassen in dem Code ?

Code:

---

Dim i As Integer
  i = 2
  Do
  intCircPattObj.SetInstanceAngularSpacing i, Me.Controls("meinetextbox" & (i)).Text
 
  '***PARAMETER ZUWEISEN
  'Hier müsste irgeneine Laufvariable rein, damit die Formeln nicht immer in die gleiche "PatternSpacing" geschrieben werden.
    Set intAngleObj = intCircPattObj.AngularRepartition.InstanceSpacing
    Set intFormulaObj = intRelsObj.CreateFormula("Formula." & 3 + i, "", intAngleObj, "WINKEL_BEFESTIGUNGEN__" & i)
    Set intAngleObj = Nothing
 
   
  i = i + 1
 
  Loop Until (i > TextBox1.Value)

---

Danke schonmal für euere Bemühungen

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

---

Hallo weylin,

Du kannst nicht direkt die Parameter des "PatternSpacing" auslesen und sie mit einer Formal verknüpfen.

Hier musst du über die Parameter-"SubList" des Patterns gehen, das "PatternSpacing" mit der richtigen "InstanceNumber" finden und das zugehörige "InstanceSpacing" mit der neu zu erstellenden Formel verknüpfen.

In etwa so (ungetestet!):

Code:

---

    Dim i As Integer
    Dim param As Parameter
    Dim itemName As String
   
    i = 2
    Do
        intCircPattObj.SetInstanceAngularSpacing i, Me.Controls("meinetextbox" & (i)).Text
       
        '***PARAMETER ZUWEISEN
        For Each param in intParametersObj.SubList(intCircPattObj, True)
            If (InStr(param.Name, "PatternSpacing") > 0) And (InStr(param.Name, "InstanceNumber") > 0) Then
                If param.ValueAsString = CStr(i) Then
                    itemName = Replace(param.Name, "InstanceNumber" ,"InstanceSpacing")
                    Set intAngleObj = intParametersObj.SubList(intCircPattObj, True).Item(itemName)
                    Set intFormulaObj = intRelsObj.CreateFormula("Formula." & 3 + i, "", intAngleObj, "WINKEL_BEFESTIGUNGEN__" & i)
                    Set intAngleObj = Nothing
                    Exit For
                End If
            End If
        Next
       
        i = i + 1
       
    Loop Until (i > TextBox1.Value)

---

mfg,
Lusilnie

------------------
Alle Aussagen zu DassaultSystemes-Produkten sind sehr optimistisch, selbst diese!!!

frei nach größeren Geistern

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

---

Vielen Dank für deine Hilfe Lusilnie. leider tritt ein Fehler auf, bei dem ich nicht weis wie ich ihn beheben kann.

Code:

---

  '***DEKLARATIONEN
    Dim intPartDocObj As PartDocument
    Dim intPartObj As Part
    Dim intShapeFacObj As ShapeFactory
    Dim intRef1Obj As Reference
    Dim intRef2Obj As Reference
    Dim intCircPattObj As circpattern
    Dim intBodyObj As Body
    Dim intHybBodiesObj As HybridBodies
    Dim intHybBody As HybridBody
    Dim intHypShapesObj As HybridShapes
    Dim intAxisObj As HybridShapeAxisLine
    Dim intRef3Obj As Reference
    Dim intShapesObj As Shapes
    Dim intObjToPattObj As Pocket
    Dim intRelsObj As Relations
    Dim intParametersObj As Parameters
    Dim intAngleObj As Angle
    Dim intFormulaObj As Formula

    '***INSTANZIERUNGEN
    Set intPartDocObj = CATIA.ActiveDocument
    Set intPartObj = intPartDocObj.Part
    Set intShapeFacObj = intPartObj.ShapeFactory
    Set intBodyObj = intPartObj.MainBody
    Set intHybBodiesObj = intBodyObj.HybridBodies
    Set intHybBody = intHybBodiesObj.Item("HILFSGEO")
    Set intHypShapesObj = intHybBody.HybridShapes
    Set intAxisObj = intHypShapesObj.Item("Achse.1")
    Set intShapesObj = intBodyObj.Shapes
    Set intObjToPattObj = intShapesObj.Item("Pocket.1")
    Set intRelsObj = intPartObj.Relations
   
    '***REFRENZEN FUER PATTERN
    Set intRef1Obj = intPartObj.CreateReferenceFromName("")
    Set intRef2Obj = intPartObj.CreateReferenceFromName("")
    Set intRef3Obj = intPartObj.CreateReferenceFromObject(intAxisObj)
   
   
    '***PATTERN ERSTELLEN
    Set intCircPattObj = intShapeFacObj.AddNewCircPattern(Nothing, 1, 2, 20#, 45#, 1, 1, intRef1Obj, intRef2Obj, True, 0#, True)
    intCircPattObj.CircularPatternParameters = catUnequalAngularSpacing
    intCircPattObj.SetUnequalInstanceNumber TextBox1.Value
    intCircPattObj.ItemToCopy = intObjToPattObj
    intCircPattObj.SetRotationAxis intRef3Obj
   
        Dim i As Integer
    Dim param As Parameter
    Dim itemName As String
   
    i = 2
    Do
        intCircPattObj.SetInstanceAngularSpacing i, Me.Controls("meinetextbox" & (i)).Text
       
        '***PARAMETER ZUWEISEN
HIer tritt Laufzeitfehler '91' auf. Objektvariable oder With-Blockvariable nicht festgelegt. Was heißt das bzw. was stört ihn?
        For Each param In intParametersObj.SubList(intCircPattObj, True)
            If (InStr(param.Name, "PatternSpacing") > 0) And (InStr(param.Name, "InstanceNumber") > 0) Then
                If param.ValueAsString = CStr(i) Then
                    itemName = Replace(param.Name, "InstanceNumber", "InstanceSpacing")
                    Set intAngleObj = intParametersObj.SubList(intCircPattObj, True).Item(itemName)
                    Set intFormulaObj = intRelsObj.CreateFormula("Formula." & 3 + i, "", intAngleObj, "WINKEL_BEFESTIGUNGEN__" & i)
                    Set intAngleObj = Nothing
                    Exit For
                End If
            End If
        Next
       
        i = i + 1
       
    Loop Until (i > TextBox1.Value)
 

---

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

---

Hallo weylin,

ich falle halt immer wieder darauf rein! Ich bin natürlich davon ausgegangen, dass deklarierte Variablen auch befüllt werden. Doch leider ist das bei anderen nicht immer selbstverständlich! 

Auflösung:
Die von mir benutzte Variable "intParametersObj" ist zwar deklariert, aber noch nicht befüllt. Daher wird beim Auslesen einer "Sublist" von dieser Variablen natürlich ein Fehler produziert. Es muss also nur noch folgende Zeile einfügt werden:

Code:

---

    Dim param As Parameter
    Dim itemName As String
   
    Set intParametersObj = intPartObj.Parameters
   
    i = 2

---

mfg,
Lusilnie

------------------
Alle Aussagen zu DassaultSystemes-Produkten sind sehr optimistisch, selbst diese!!!

frei nach größeren Geistern

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

---

Super Lusilnie da war der Fehler. Es funktioniert auch einwand frei. *thumbsup*

Ich wollte noch das in der Schleife die benötigten Winkelparameter mit erstellt werden.
Hab mir das so vorgestellt:

Code:

---

Dim parameters() As parameters
      Set parameters(i) = part1.parameters

      Dim angle() As angle
      Set angle(i) = parameters(i).CreateDimension("", "ANGLE", 0#)

      angle(i).Rename "WINKEL" & i
      angle(i).Value = 20#

---

Doch das war zueinfach gedacht. Weis jemand wie das richtig funktioniert ?
VIelen Dank schonmal für Eure Bemühungen
Viele Grüße
Weylin

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

---

Hallo weylin,

ich kann mich langsam des Eindrucks nicht mehr erwehren, dass Du Dich nicht mit der Materie der Programmierung in V5 beschäftigen willst!

O.K., ich versuch es trotzdem mal mit meinen Kenntnissen zu erklären:
1.) Warum willst Du die Dimensionierung der Variablen in der Schleife machen? Das gehört außerhalb der Schleife, sonst bekommst du eventuell Probleme mit der Doppeldeklaration von Variablen.
2.) Warum willst Du ein Parameter-Array erstellen? Den Parameter erstellst du für jeden Durchlauf immer neu.

Daher lautet mein Vorschlag:

Code:

---

    Dim param As Parameter
    Dim newParam As Parameter
    Dim newAngle As angle
    Dim itemName As String

---

und:

Code:

---

                    itemName = Replace(param.Name, "InstanceNumber" ,"InstanceSpacing")
                    Set intAngleObj = intParametersObj.SubList(intCircPattObj, True).Item(itemName)
                   
                    Set newParam = intPartObj.parameters
                    Set newAngle = newParam.CreateDimension("", "ANGLE", 0#)
                    newAngle.Rename "WINKEL" & i
                    newAngle.Value = intAngleObj.ValueAsString

                    Set intFormulaObj = intRelsObj.CreateFormula("Formula." & 3 + i, "", intAngleObj, newAngle)
                    Set intAngleObj = Nothing
                    Exit For

---

Der Code ist wieder nicht getestet, dies überlasse ich Dir! Viel Erfolg!

mfg,
Lusilnie

------------------
Alle Aussagen zu DassaultSystemes-Produkten sind sehr optimistisch, selbst diese!!!

frei nach größeren Geistern

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