Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  CATIA V5 Programmierung
  Rechteckmuster Richtung ermitteln

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  Rechteckmuster Richtung ermitteln (1143 mal gelesen)
Estafanos
Mitglied



Sehen Sie sich das Profil von Estafanos an!   Senden Sie eine Private Message an Estafanos  Schreiben Sie einen Gästebucheintrag für Estafanos

Beiträge: 27
Registriert: 17.07.2012

Catia V5 R22, Windows 7

erstellt am: 21. Feb. 2017 14:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Zusammen,
leider komme ich mit einem Punkt nicht weiter.
Es wird gerade ein Makro programmiert das ein Rechteckmuster (RectangularPattern) aus dem PartDesign ins GSD (Generative Shape Design) übertragen soll um dort ein anderes Objekt z. B. Fläche damit zu Mustern.
Mit Kreismuster und Benutzerdefinierten Mustern klappt es schon. Beim Rechteckmuster ist das Problem wie kann man die 1. und 2. Direction auslesen (objPattern) und ins GSD (MyNeurectPattern) übertragen. Direction können auch Kanten sein.

Vielen Dank für eure Unterstützung.
Gruß
Estafanos


[CODE][/CODE]
Sub CATRectPattern()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim shapeFactory1 As ShapeFactory
Set shapeFactory1 = part1.ShapeFactory
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")
Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes
hybridShapeCylinder1_Name = "Flaeche_1"
'Set iShapeToCopy = hybridShapes1.Item(hybridShapeCylinder1_Name)

'Muster RectPattern-----------------------------------------------
Dim objSel As Selection

Set objPartDoc = CATIA.ActiveDocument
Set objSel = objPartDoc.Selection

objSel.Clear
objSel.Search "CATPrtSearch.RectPattern,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
        Set objPattern = objSel.Item(i).Value
        objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name

    Next
End If


    Rem Hier handelt sich um Mustern entlang eine Richtung oder zwei Richtungen
    Rem Property Index
        Rem (Done) FirstDirectionRepartition: Returns the linear repartition along the first direction.
        Rem FirstDirectionRow: Returns the position of the shape to be copied along the first linear direction.
        Rem (Done) FirstOrientation: Returns or sets whether the pattern is built towards the first direction orientation.
        Rem FirstRectangularPatternParameters: Returns or sets the rectangular pattern parameters required to define the pattern.
        Rem (Done) SecondDirectionRepartition: Returns the linear repartition along the second direction.
        Rem SecondDirectionRow: Returns the position of the shape to be copied along the second linear direction.
        Rem (Done) SecondOrientation:Returns or sets whether the pattern is built towards the second direction orientation.
        Rem SecondRectangularPatternParameters:Returns or sets the rectangular pattern parameters required to define the pattern.
       
        objPatternFirstRectangularPatternParameters = objPattern.FirstRectangularPatternParameters
        objPatternSecondRectangularPatternParameters = objPattern.SecondRectangularPatternParameters
    Rem Method Index
        Rem GetFirstDirection: Returns the first repartition direction.
            Dim FirstDir(2) As Variant
            objPattern.GetFirstDirection (FirstDir)
            XFirstDir = FirstDir(0)
            YFirstDir = FirstDir(1)
            ZFirstDir = FirstDir(2)

        Rem GetSecondDirection: Returns the second repartition direction. ' Funktioniert nicht bei Plan
            Dim SecondDir(2)
            objPattern.GetSecondDirection (SecondDir)
            xSecondDir = SecondDir(0)
            ySecondDir = SecondDir(1)
            zSecondDir = SecondDir(2)
           
           
        Instance_objPattern_FirstDirektion = objPattern.FirstDirectionRepartition.InstancesCount.Value
        Instance_objPattern_SecendDirektion = objPattern.SecondDirectionRepartition.InstancesCount.Value
           
        Spacing_objPattern_FirstDirektion = objPattern.FirstDirectionRepartition.Spacing.Value
        Spacing_objPattern_SecendDirektion = objPattern.SecondDirectionRepartition.Spacing.Value
           
        objPattern_FirstOrientation = objPattern.FirstOrientation
        objPattern_SecondOrientation = objPattern.SecondOrientation
           
           
        objPattern_FirstDirectionRow = objPattern.FirstDirectionRow.Name
        Rem SetFirstDirection: Sets the first repartition direction.
        aligned1 = objPattern.FirstOrientation
        Rem SetInstanceSpacing: Sets the InstanceSpacing.
        Rem SetSecondDirection: Sets the second repartition direction.
       
        Dim reference1 As Reference
        Set reference1 = part1.CreateReferenceFromName("")

        Dim reference2 As Reference
        Set reference2 = part1.CreateReferenceFromName("")

        Dim MyNeurectPattern As RectPattern
        Rem Set MyNeurectPattern = shapeFactory1.AddNewSurfacicRectPattern(iShapeToCopy, 2, 1, 20#, 20#, 1, 1, reference1, reference2, True, True, 0#)

        MyNeurectPattern.FirstRectangularPatternParameters = objPatternFirstRectangularPatternParameters

        MyNeurectPattern.SecondRectangularPatternParameters = objPatternSecondRectangularPatternParameters
       
        MyNeurectPattern.SetFirstDirection refToLine1
       
        hybridBody1.AppendHybridShape MyNeurectPattern
        part1.Update
           

End Sub

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

joehz
Moderator
Freiberuflicher Konstrukteur


Sehen Sie sich das Profil von joehz an!   Senden Sie eine Private Message an joehz  Schreiben Sie einen Gästebucheintrag für joehz

Beiträge: 1057
Registriert: 25.11.2006

Win7 Pro 64 + Ubuntu + Irix6.5.20
Dell Precision M6600 i7-2960XM 2.7GHz 16GB
NVidia Quadro M5010
Catia V5R19
VB6Pro.SP6/VBA 6.5.1053

erstellt am: 21. Feb. 2017 15:32    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Estafanos 10 Unities + Antwort hilfreich

Hi Estefanos,

willst Du ein neues Pattern anlegen und dazu die Richtungen bestimmen?
Oder ein vorhandenes Pattern analysieren?

Ausserdem: So wie die Schleife aufgebaut ist, bearbeitest Du stets nur das letzte 'objPattern' im weiteren Programmverlauf.
Ist das so gewollt?

Tschau,
Joe

PS: Der Code kommt zwischen die [CODE]-Tags :-)

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

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

joehz
Moderator
Freiberuflicher Konstrukteur


Sehen Sie sich das Profil von joehz an!   Senden Sie eine Private Message an joehz  Schreiben Sie einen Gästebucheintrag für joehz

Beiträge: 1057
Registriert: 25.11.2006

Win7 Pro 64 + Ubuntu + Irix6.5.20
Dell Precision M6600 i7-2960XM 2.7GHz 16GB
NVidia Quadro M5010
Catia V5R19
VB6Pro.SP6/VBA 6.5.1053

erstellt am: 21. Feb. 2017 16:52    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Estafanos 10 Unities + Antwort hilfreich

Hi Estefanos,

ich hab noch ein bisschen mit dem Pattern gespielt.

Ich behaupte, die Zeile

Code:
  objPattern.GetFirstDirection (FirstDir)

liefert für 'FirstDir' nix, sprich ein leeres Array zurück.

Probier mal stattdessen

Code:
  objPattern.GetFirstDirection FirstDir

oder
Code:

'________VBA-Modul________
Sub catmain2()
  Dim oAD As PartDocument
  Dim oADP As Part
  Dim arrDir1(2)                                          ' As Variant
  Dim arrDir2(2)
  Dim objPattern As Object                                'RectPattern
  Dim oDirInst1
  Dim oDirInst2
  Dim oDirSpc1
  Dim oDirSpc2
  Dim oDirOrient1
  Dim oDirOrient2

  Set oAD = CATIA.ActiveDocument
  Set oADP = oAD.Part
  Set objPattern = oADP.FindObjectByName("RectPattern.1")

  If TypeName(objPattern) <> "Nothing" Then
      objPattern.GetFirstDirection arrDir1
      Debug.Print arrDir1(0), arrDir1(1), arrDir1(2)
     
      objPattern.GetSecondDirection arrDir2
      Debug.Print arrDir2(0), arrDir2(1), arrDir2(2)
     
      oDirInst1 = objPattern.FirstDirectionRepartition.InstancesCount.Value
      oDirInst2 = objPattern.SecondDirectionRepartition.InstancesCount.Value
      Debug.Print oDirInst1, oDirInst2
     
      oDirSpc1 = objPattern.FirstDirectionRepartition.Spacing.Value
      oDirSpc2 = objPattern.SecondDirectionRepartition.Spacing.Value
      Debug.Print oDirSpc1, oDirSpc2

      oDirOrient1 = objPattern.FirstOrientation
      oDirOrient2 = objPattern.SecondOrientation
      Debug.Print oDirOrient1, oDirOrient2

  End If

End Sub



wobei das RectPattern mit Namen 'RectPattern.1' existieren muss.
Typischer Output:
------------------------------------------------
-1            -3.83999874084854E-17        0
0            1            0
9            4
20          -20
True          True
------------------------------------------------
Tschau,
Joe

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

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

bgrittmann
Moderator
Konstrukteur


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 21. Feb. 2017 17:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Estafanos 10 Unities + Antwort hilfreich

Servus

Vermutlich ist das Kernproblem dabei, dass man bei einem bestehenden Pattern die Richtung nur als Vektor auslesen kann, aber bei neu anlegen eines Pattern (oder ändern der Richtung) eine Reference übergeben muss.
ggf geht es über (ungetestet): aus dem Vektor über AddNewDirectionByCoord eine Direction erzeugen und aus dieser dann eine Refernce bilden (CreateReferenceByObject)

Gruß
Bernd

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

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

Estafanos
Mitglied



Sehen Sie sich das Profil von Estafanos an!   Senden Sie eine Private Message an Estafanos  Schreiben Sie einen Gästebucheintrag für Estafanos

Beiträge: 27
Registriert: 17.07.2012

Catia V5 R22, Windows 7

erstellt am: 21. Feb. 2017 23:12    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Joe, hallo Bernd,
lieben Dank für die Hinweise und die rasche Antwort.
Anstatt "objPattern.GetFirstDirection (FirstDir)" wurde "objPattern.GetFirstDirection FirstDir" deklariert, dann hat es sehr gut funktioniert.
Es hat  auch sehr gut mit der Vektor-Erzeugung (AddNewDirectionByCoord) und danach als Reference über „CreateReferenceByObject“ funktioniert. Jetzt habe ich ein weiteres Problem, wie Joe geschrieben hat, dass nur das letzte Muster genommen wird. Ich habe z. B. Muster und als „ItemToCopy“ ein Bohrung-Objekt. Die Input-Werte von diesem Muster (Bohrungen) sollen eingelesen werden, damit ein neues Muster (im GSD) mit bestimmten Flächen erzeugt wird.

Es gibt viele Bauteile, die ich bereuen soll. In diesen Bauteilen gibt es viele Mustern und viele Bohrungen, die in alle X-, Y- und Z-Richtungen verteilt sind. 

Könntet ihr mir bitte  helfen?
Viele Grüße
Estafanos

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

bgrittmann
Moderator
Konstrukteur


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 21. Feb. 2017 23:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Estafanos 10 Unities + Antwort hilfreich

Servus
Du musst doch nur das Ende der For-Next-Schleife ganz ans Ende setzen, dann werden alle gefundenen Muster abgearbeitet.

Gruß
Bernd

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

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

joehz
Moderator
Freiberuflicher Konstrukteur


Sehen Sie sich das Profil von joehz an!   Senden Sie eine Private Message an joehz  Schreiben Sie einen Gästebucheintrag für joehz

Beiträge: 1057
Registriert: 25.11.2006

Win7 Pro 64 + Ubuntu + Irix6.5.20
Dell Precision M6600 i7-2960XM 2.7GHz 16GB
NVidia Quadro M5010
Catia V5R19
VB6Pro.SP6/VBA 6.5.1053

erstellt am: 22. Feb. 2017 00:13    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Estafanos 10 Unities + Antwort hilfreich

Zitat:

Jetzt habe ich ein weiteres Problem, dass nur das letzte Muster genommen wird.

Wenn Du alle Teile analysieren willst, musst die Schleife entsprechend erweitern.

Zitat:

Es gibt viele Bauteile, die ich bereuen soll.


Ich kenne viele Konstrukteure, aber keinen,
der seine Bauteile bereut(obwohl sie's müssten)! :-)

Tschau,
Joe

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

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

Estafanos
Mitglied



Sehen Sie sich das Profil von Estafanos an!   Senden Sie eine Private Message an Estafanos  Schreiben Sie einen Gästebucheintrag für Estafanos

Beiträge: 27
Registriert: 17.07.2012

Catia V5 R22, Windows 7

erstellt am: 22. Feb. 2017 17:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Zusammen,
jetzt stoße ich auf ein weiteres Problem. Das Ursprungsgewinde wurde mit der Funktion "Thread" separat erzeugt, das ich lesen muss und als Fläche erstellen soll. Das Zukünftige Gewinde soll als Fläche in einem Geometrical Set erzeugt werden. Die Funktion "Thread" hat folgende Parameter oder Referenzen:
- Lateral Face
- Limit Face
- Diameter (das kann ich lesen)
- Depth (das kann ich lesen)
- Pitch (das kann ich lesen)

Wie kann man "Lateral Face" und "Limit Face" aus einem vorhandenen Gewinde als Vektor/Linie und Ebene erstellen, damit ich die neue Fläche erzeugen kann?

Vielen Dank für eure Hilfe.

Gruß
Estafanos

[CODE][/CODE]
    Dim objSel As Selection
    Dim objPartDoc 'As PartDocument
    'Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness As Variant
    Dim objHole, objChamfer, objFillet, objThread, objThickness As Variant
    Dim i As Integer
    Set objPartDoc = CATIA.ActiveDocument
    Set objSel = objPartDoc.Selection
    Set selection1 = CATIA.ActiveDocument.Selection
    Set visPropertySet1 = selection1.VisProperties
   
'Außengewinde
objSel.Clear
objSel.Search "CATPrtSearch.Thread,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
        Set objHoleThread = objSel.Item(i).Value
        Dim objHoleThreadType As String

               
                Ende_Gewinde_LimitFaceElement = objHoleThread.LimitFaceElement.Name
               

                objHoleThread_Name = objHoleThread.Name ' Name
                objHoleThread_Diameter = objHoleThread.Diameter 'Durchmesser
                objHoleThread_Pitch = objHoleThread.Pitch 'Steigung
                objHoleThread_Depth = objHoleThread.Depth 'Tiefe

                Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces")
                Set sketch1 = objHole.Sketch
                Set originElements1 = part1.OriginElements

                Dim coordArrayThreadThread(2)
                objHoleThread.GetOrigin coordArrayThread
                XcoordArrayThread = coordArrayThread(0)
                YcoordArrayThread = coordArrayThread(1)
                ZcoordArrayThread = coordArrayThread(2)
                Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(XcoordArrayThread, YcoordArrayThread, ZcoordArrayThread)
                Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces")
                hybridBody1.AppendHybridShape hybridShapePointCoord1
                part1.InWorkObject = hybridShapePointCoord1
                part1.Update
                Dim dirArrayThread(2)
                objHole.GetDirection dirArrayThread
                XdirArrayThread = dirArrayThread(0)
                YdirArrayThread = dirArrayThread(1)
                ZdirArrayThread = dirArrayThread(2)
                'create explicit direction
                Set objHoleDirection = hybridShapeFactory1.AddNewDirectionByCoord(XdirArrayThread, YdirArrayThread, ZdirArrayThread)
                Dim refHoleDirectionThread As Reference
                Set refHoleDirectionThread = part1.CreateReferenceFromObject(objHoleDirection)
                hybridBody1.AppendHybridShape objHoleDirection
                part1.Update
                Dim reference1Thread As Reference
                Set reference1Thread = part1.CreateReferenceFromObject(hybridShapePointCoord1)
                Dim hybridShapeCylinder1Thread As HybridShapeCylinder
                Set hybridShapeCylinder1Thread = hybridShapeFactory1.AddNewCylinder(reference1Thread, Durchmesser_Gewinde / 2, Gewinde_Tiefe, 0#, objHoleDirection)
                hybridShapeCylinder1Thread.Orientation = False
                hybridBody1.AppendHybridShape hybridShapeCylinder1Thread
                part1.InWorkObject = hybridShapeCylinder1Thread
                hybridShapeCylinder1Thread_Name = objHole.Name
                hybridShapeCylinder1Thread.Name = "Surface_" & hybridShapeCylinder1_Name
                part1.Update

        Next
End If

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

bgrittmann
Moderator
Konstrukteur


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 22. Feb. 2017 17:49    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Estafanos 10 Unities + Antwort hilfreich

Servus
Der Code sollt immer noch innerhalb der Code-Tags gepostet werden *grins*
ggf kannst du mit der Messfunktion (SPA-Workbench) aus den beiden Elementen (Reference) was auslesen (GetAxis, GetPointsOnAxis , GetPlain).

Was soll den das ganze werden wenn es fertig ist?

Gruß
Bernd

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

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

joehz
Moderator
Freiberuflicher Konstrukteur


Sehen Sie sich das Profil von joehz an!   Senden Sie eine Private Message an joehz  Schreiben Sie einen Gästebucheintrag für joehz

Beiträge: 1057
Registriert: 25.11.2006

Win7 Pro 64 + Ubuntu + Irix6.5.20
Dell Precision M6600 i7-2960XM 2.7GHz 16GB
NVidia Quadro M5010
Catia V5R19
VB6Pro.SP6/VBA 6.5.1053

erstellt am: 22. Feb. 2017 19:49    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Estafanos 10 Unities + Antwort hilfreich

Hi Estefanos,

kurz zu Deinem letzten Makro:

Code:

Dim objSel As Selection
    Dim objPartDoc 'As PartDocument
    'Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness As Variant
    Dim objHole, objChamfer, objFillet, objThread, objThickness As Variant


Der Default-Typ für Variable ist 'Variant'.
Deshalb kannst statt
Code:
Dim objThickness As Variant

genausogut
Code:
Dim objThickness

schreiben.
Eine Anweisung
Code:

Dim i, j, n as integer


weist nicht 'i' und 'j' den Typ 'Integer zu;
lediglich 'n' bekommt den Typ zugeweisen.

Ausserdem: 'Dim'-Zuweisungen haben innerhalb einer Schleife nix verloren;
generell nicht, ohne Ausnahmen.

Tschau,
Joe

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

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

Estafanos
Mitglied



Sehen Sie sich das Profil von Estafanos an!   Senden Sie eine Private Message an Estafanos  Schreiben Sie einen Gästebucheintrag für Estafanos

Beiträge: 27
Registriert: 17.07.2012

Catia V5 R22, Windows 7

erstellt am: 24. Feb. 2017 10:31    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Zusammen,
Die Anwender verwenden für die Gewindedarstellung im 3D-Modell die Funktion „Thread/Tap“    (Part Design). Aus der „Thread/Tap“  soll eine Fläche in einem „Geometrical Set“ erzeugt werden. Aus der Funktion „Thread/Tap“  kann ich folgende Informationen lesen (im Code):

- Name
- Durchmesser
- Steigung
- Tiefe

Aus „Lateral Face“ und „Limit Face“ sollen die Richtung und der Mittelpunkt des Gewindes erstellt werden, damit die gewünschte Fläche abgeleitet werden kann.

Code:

Sub CATMain()
Dim partDocument1 As PartDocument
    Set partDocument1 = CATIA.ActiveDocument
   
    Dim part1 As Part
    Set part1 = partDocument1.Part
   
    Dim hybridBodies1 As HybridBodies
    Set hybridBodies1 = part1.HybridBodies
    Set ohyBody = hybridBodies1.Add()
    ohyBody.Name = "Theard_Surfaces"
    part1.InWorkObject = ohyBody
   
    part1.Update
   
   
    Dim objSel As Selection
    Dim objPartDoc 'As PartDocument
    'Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness As Variant
    Dim objHole, objChamfer, objFillet, objThread, objThickness As Variant
    Dim i As Integer
    Set objPartDoc = CATIA.ActiveDocument
    Set objSel = objPartDoc.Selection
    Set selection1 = CATIA.ActiveDocument.Selection
    Set visPropertySet1 = selection1.VisProperties
   
'Außengewinde-----------------------------------------------
objSel.Clear
objSel.Search "CATPrtSearch.Thread,all"
If objSel.Count > 0 Then
    For i = 1 To objSel.Count
        Set objHoleThread = objSel.Item(i).Value
        Dim objHoleThreadType As String
       
                Ende_Gewinde_LimitFaceElement = objHoleThread.LimitFaceElement.Name 'LimitFaceElement
                objHoleThread_Name = objHoleThread.Name 'Thread.Name
                objHoleThread_Diameter = objHoleThread.Diameter ' Durchmesser
                objHoleThread_Pitch = objHoleThread.Pitch 'Steigung
                objHoleThread_Depth = objHoleThread.Depth ' Tiefe
                Set HoleThreadDescription = objHoleThread.ThreadDescription  'ThreadDescription
                'Set Ursprungspunkt_Gewinde = objHole.Sketch.GeometricElements.Item(2)
                objHoleThread_NameLFaceElement = objHoleThread.LimitFaceElement.DisplayName  'LimitFaceElement.DisplayName
                objHoleThread_NameLateralFaceElement = objHoleThread.LateralFaceElement.DisplayName 'LateralFaceElement.DisplayName
                oName = objHoleThread.Parent.Parent.Name
                Dim objHoleThread_NameLateralFaceElement1 As String
                objHoleThread_NameLateralFaceElement1 = objHoleThread_NameLFaceElement
                Dim objHoleThread_NameLimitFaceElement1 As String
                objHoleThread_NameLimitFaceElement1 = objHoleThread_NameLateralFaceElement
                'Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces")
                oName2 = objHoleThread.Parent.Name
               
               
                ' Heir sollen aus LimitFaceElement und LateralFaceElement die Richtung, Ebene und Punkt (Mittelpunkt vom Gewinde)in einem Geoterical set erzeugt werden.
               
                ' als Beispiel: AddNewDirectionByCoord, AddNewPointCoord, AddNewCylinder
               
               
               
               
               
               
               
               
               
               
               
               
               
                ' noch zu bearbeiten
               
                Dim reference11 As Reference
                Set reference11 = CATIA.ActiveDocument.Part.CreateReferenceFromBRepName(objHoleThread_NameLateralFaceElement1, hole1)
               
                Dim hybridShapeAxisLine1 As HybridShapeAxisLine
                Set hybridShapeAxisLine1 = CATIA.ActiveDocument.PartHybridShapeFactory.AddNewAxisLine(reference11)
                'objHoleThread.LateralFaceElement = reference11

                Dim reference21 As Reference
                Set reference21 = CATIA.ActiveDocument.Part.CreateReferenceFromBRepName(objHoleThread_NameLimitFaceElement1, hole1)

                hybridShapeAxisLine1.AxisLineType = 1

                hybridBody1.AppendHybridShape hybridShapeAxisLine1

             
                Dim coordArrayThreadThread(2)
                objHoleThread.GetOrigin coordArrayThread
                XcoordArrayThread = coordArrayThread(0)
                YcoordArrayThread = coordArrayThread(1)
                ZcoordArrayThread = coordArrayThread(2)
                Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(XcoordArrayThread, YcoordArrayThread, ZcoordArrayThread)
                Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces")
                hybridBody1.AppendHybridShape hybridShapePointCoord1
                part1.InWorkObject = hybridShapePointCoord1
                part1.Update
                'Dim dirArrayThread(2)
                'objHole.GetDirection dirArrayThread
                'XdirArrayThread = dirArrayThread(0)
                'YdirArrayThread = dirArrayThread(1)
                'ZdirArrayThread = dirArrayThread(2)
                'create explicit direction
                Set objHoleDirection = hybridShapeFactory1.AddNewDirectionByCoord(XdirArrayThread, YdirArrayThread, ZdirArrayThread)
                Dim refHoleDirectionThread As Reference
                Set refHoleDirectionThread = part1.CreateReferenceFromObject(objHoleDirection)
                hybridBody1.AppendHybridShape objHoleDirection
                part1.Update
                Dim reference1Thread As Reference
                Set reference1Thread = part1.CreateReferenceFromObject(hybridShapePointCoord1)
                Dim hybridShapeCylinder1Thread As HybridShapeCylinder
                Set hybridShapeCylinder1Thread = hybridShapeFactory1.AddNewCylinder(reference1Thread, Durchmesser_Gewinde / 2, Gewinde_Tiefe, 0#, objHoleDirection)
                hybridShapeCylinder1Thread.Orientation = False
                hybridBody1.AppendHybridShape hybridShapeCylinder1Thread
                part1.InWorkObject = hybridShapeCylinder1Thread
                hybridShapeCylinder1Thread_Name = objHole.Name
                hybridShapeCylinder1Thread.Name = "Surface_" & hybridShapeCylinder1_Name
                part1.Update


        Next

End If

End Sub


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

Estafanos
Mitglied



Sehen Sie sich das Profil von Estafanos an!   Senden Sie eine Private Message an Estafanos  Schreiben Sie einen Gästebucheintrag für Estafanos

Beiträge: 27
Registriert: 17.07.2012

Catia V5 R22, Windows 7

erstellt am: 27. Feb. 2017 11:35    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


The_method_GetCoG_failed.JPG

 
Hallo Bernd,
1000 Dank für die Methode. Diese Methode hat gestern auf einem Rechner sehr gut funktioniert. Jetzt auf einem anderen Rechner nicht mehr. Es tut mir leid diesen Code nochmal hochladen zu müssen, aber vielleicht kannst mir einen Tipp geben, wo der Fehler sein könnte?

Es kommt zu der Fehlermeldung "The method GetCoG failed". Besten Dank Estafanos

Code:

Sub CATMain()
    Dim partDocument1 As PartDocument
    Set partDocument1 = CATIA.ActiveDocument
   
    Dim part1 As Part
    Set part1 = partDocument1.Part
    Dim ohyBody
    Dim hybridBodies1 As HybridBodies
    Set hybridBodies1 = part1.HybridBodies
    Set ohyBody = hybridBodies1.Add()
    ohyBody.Name = "Theard_Surfaces"
    Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces")
    Dim hybridShapes1 As HybridShapes
    Set hybridShapes1 = hybridBody1.HybridShapes

    part1.InWorkObject = ohyBody
   
    Dim hybridShapeFactory1 As HybridShapeFactory
    Set hybridShapeFactory1 = part1.HybridShapeFactory
   
    part1.Update
    Dim objSel As Selection
    Dim objHole, objChamfer, objFillet, objThread, objThickness 'As Variant
    Dim i As Integer
    Set objSel = partDocument1.Selection
   
'Außengewinde
objSel.Clear

objSel.Search "CATPrtSearch.Thread,all"
If objSel.Count > 0 Then


    For i = 1 To objSel.Count
   
        Dim objHoleThread_Name1
        Dim objHoleThread_Diameter
        Dim objHoleThread_Pitch
        Dim objHoleThread_Depth
        Dim HoleThreadDescription
        Dim objHoleThread_LimitFaceElement
        Dim objHoleThread_NameLateralFaceElement
   
        Dim objHoleThread
        Dim UserSel
        Set UserSel = objSel.Item(i).Value
        Dim TheSPAWorkbench
        Dim Inertia1
        Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
        Set Inertia1 = TheSPAWorkbench.Inertias.Add(UserSel)
       
        'Parameter Einlesen
        objHoleThread_Name1 = UserSel.Name                        'Thread.Name
        objHoleThread_Diameter = UserSel.Diameter                'Durchmesser
        objHoleThread_Pitch = UserSel.Pitch                      'Steigung
        objHoleThread_Depth = UserSel.Depth                      'Tiefe
        Set HoleThreadDescription = UserSel.ThreadDescription    'ThreadDescription

       
        Set part1 = CATIA.ActiveDocument.Part
       
        objHoleThread_NameLateralFaceElement = UserSel.LateralFaceElement.DisplayName  'LateralFaceElement
        Dim objHoleThread_NameLateralFaceElement1 As String
        objHoleThread_NameLateralFaceElement1 = ""
        objHoleThread_NameLateralFaceElement1 = objHoleThread_NameLateralFaceElement
        Dim refobjHoleThread_NameLateralFaceElement As Reference
        Set refobjHoleThread_NameLateralFaceElement = CATIA.ActiveDocument.Part.CreateReferenceFromName(objHoleThread_NameLateralFaceElement1)


        objHoleThread_NameLimitFaceElement = UserSel.LimitFaceElement.DisplayName 'LimitFaceElement
        Dim objHoleThread_NameLimitFaceElement1 As String
        objHoleThread_NameLimitFaceElement1 = ""
        objHoleThread_NameLimitFaceElement1 = objHoleThread_NameLimitFaceElement
        Dim refobjHoleThread_NameLimitFaceElement As Reference
        Set refobjHoleThread_NameLimitFaceElement = CATIA.ActiveDocument.Part.CreateReferenceFromName(objHoleThread_NameLimitFaceElement1)
        'Schwerpunkt
        Dim reference1
        Dim Measurable1
        Set reference1 = part1.CreateReferenceFromObject(UserSel)
        Set Measurable1 = TheSPAWorkbench.GetMeasurable(refobjHoleThread_NameLateralFaceElement)
        Dim GcoordLateralFaceElement(2)
        Measurable1.GetCOG GcoordLateralFaceElement
       
        'GetAxis
        Dim Measurable3
        Set Measurable3 = TheSPAWorkbench.GetMeasurable(reference1)
        Dim oAxisVector(2)
        Measurable1.GetAxis oAxisVector 'GetAxis

Next

End Sub



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

bgrittmann
Moderator
Konstrukteur


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 27. Feb. 2017 11:52    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Estafanos 10 Unities + Antwort hilfreich

Servus Estafanos
Ich kann dir leider nicht weiterhelfen, bei meinen Tests hat eine Messung an den Referenzelementen der Gewinde nie geklappt.

Gruß
Bernd

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

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz