Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  CATIA V5 Programmierung
  ProductToPart für Arme

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:  ProductToPart für Arme (5083 mal gelesen)
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: 27. Feb. 2015 14:40    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 Leut',

ich wollte kurz mein Macro 'Poor Man's Product To Part' vorstellen.

Falls nur Solids kopiert werden müssen, reicht's schon aus.
Wer geschlossene Flächen, Achsensysteme etc. braucht, muss noch warten.

Lauffähig/entwickelt im VBA-Editor.

Enjoy,
Joe

Code:

Option Explicit
Const strVersion As String = "V1.0"
Const strMacroName As String = "Poor Man's ProductToPart"

Public iBodyCount As Integer          'counter for stats
Public oRefAx As AxisSystem            'Part Ref axis system,1/1/1;0/0/0
Public oDestDoc As PartDocument        'destinaton for allcatpart

Sub CatMain()
  Dim oRootProd As Product
  Dim oSourceWindow As Window
  Dim arrRootPos(11)
  Dim tmStart As Date
  Dim tmEnd As Date
 
  tmStart = Time$
  iBodyCount = 0
 
  Set oSourceWindow = CATIA.ActiveWindow
  Set oRootProd = GetRootProd
  If oRootProd Is Nothing Then End
  Set oDestDoc = CreateNewPart(oRootProd.Name & "_AllCatPart", "AllCatPart aus " & oRootProd.Name)  'create destination part
  Set oRefAx = CreateNewAxisSp(oDestDoc.Part, "RefAxis")
  oSourceWindow.Activate
 
  arrRootPos(0) = 1                                                'reset axis cooords to
  arrRootPos(1) = 0                                                'standard r/h system
  arrRootPos(2) = 0
  arrRootPos(3) = 0
  arrRootPos(4) = 1
  arrRootPos(5) = 0
  arrRootPos(6) = 0
  arrRootPos(7) = 0
  arrRootPos(8) = 1
  arrRootPos(9) = 0
  arrRootPos(10) = 0
  arrRootPos(11) = 0

  CATIA.RefreshDisplay = False
  CATIA.DisplayFileAlerts = False
  CATIA.HSOSynchronized = False
 
  RunTree oRootProd, arrRootPos()
 
  oDestDoc.Part.Update
 
  CATIA.HSOSynchronized = True
  CATIA.DisplayFileAlerts = True
  CATIA.RefreshDisplay = True
  CATIA.StatusBar = "Macro finished. "

  tmEnd = Time$
  MsgBox "Start: " & tmStart & vbCrLf _
        & "Ende: " & tmEnd & vbCrLf _
        & iBodyCount & " Bodies copied.", _
        vbOKOnly Or vbInformation, strMacroName & "/" & strVersion
End Sub

Function GetRootProd() As Product
  Dim oSel As Selection

  Set oSel = CATIA.ActiveDocument.Selection
  If oSel.Count2 = 1 Then
      If oSel.Item(1).Type = "Product" Then
        Set GetRootProd = oSel.Item2(1).Value
      Else
        MsgBox "This macro needs a product to work!" & vbCr & "Exiting macro ...", vbOKOnly Or vbCritical, "GetRootProd - " & strMacroName & "/" & strVersion
      End If
  Else
      MsgBox "Select a product first!" & vbCr & "Exiting macro ...", vbOKOnly Or vbCritical, "GetRootProd - " & strMacroName & "/" & strVersion
      End
  End If

End Function

Sub RunTree(oRoot As Product, arrRootProd())
  Dim i As Integer
  Dim n As Integer
  Dim arrInv(11)                                        'inverse pos
  Dim arrPos(11)                                        'part pos
  Dim arrProdPos(11)                                    'prod pos
  Dim arrResPos(11)                                    'result from part matrix multiply
  Dim arrResProdPos(11)                                'result from product matrix multiply
  Dim oProdItem As Object 'Product
  Dim strCoord As String
  Dim oP As Part
  Dim oSel As Selection                                'source selection
  Dim oDestSel As Selection                            'destination selection
  Dim showstate As CatVisPropertyShow
  Dim strNewBody As String                              'name of created body
  Dim oTransAx As Object 'AxisSystem                    'Dest Ax Sys for catpart Ax2Ax translation
  Dim arrOrg(2)                                        'PutOrigin - array
  Dim arrVX(2)                                          'PutXAxis - array
  Dim arrVY(2)                                          'PutYAxis - array
  Dim arrVZ(2)                                          'PutZAxis - array
  Dim oRefRefAx As Reference                            'Ref element source
  Dim oRefTransAx As Reference                          'Ref element dest
  Dim oAxisToAxis As ShapeFactory                      'translate op

'---------------------------------------------------------------------------------------------------
' TODO:
' - rearrange code within loops/If-Else-cases
' - shapes.count reicht nicht aus; bodies mit aufgeboolten leeren bodies werden nicht ausgeschlossen!
' - body-bezeichnungen ändern -> (Product.Instance)/(Product.Instance)/PartNumber.Instance/BodyName
'(- alle bodies aus allcatpart in neues catpart kopieren; -> die achsen und translates verschwinden;)
' - arrays umbenennen
' - untersuchen, ob instanzen komplett kopiert werden können (Strategie?)
' - body-translation als datum/blitz?
' - closed shells berücksichtigen! (-> geosets checken)
' - achsensysteme kopieren
'---------------------------------------------------------------------------------------------------
 
  Set oSel = CATIA.ActiveDocument.Selection
 
  For i = 1 To oRoot.Products.Count
'    MsgBox oRoot.Products.Item(i).Name
      Set oProdItem = oRoot.Products.Item(i)
     
      oSel.Clear
      oSel.Add oProdItem                                          'check if noshow
      oSel.VisProperties.GetShow showstate                        'is the part visible, go on
      oSel.Clear
     
      If showstate = catVisPropertyShowAttr Then                  'if noshow, skip
        oProdItem.ApplyWorkMode (DEFAULT_MODE)                  'set work mode to default
       
        If TypeName(oProdItem.ReferenceProduct.Parent) = "ProductDocument" Then
            oProdItem.position.GetComponents arrProdPos          'get zb axis coords if in zb
            'multiply new array with old array; FIRST arg must be NEW array!
            MatrixProduct arrProdPos, arrRootProd, arrResProdPos  'build array product
            RunTree oProdItem, arrResProdPos                      'reenter one level down
        ElseIf TypeName(oProdItem.ReferenceProduct.Parent) = "PartDocument" Then
           
            oProdItem.position.GetComponents arrPos
           
            'combine axis position arrays
            MatrixProduct arrPos, arrRootProd, arrResPos          'build resulting array (NEW,OLD,RESULT)!
           
            Set oTransAx = CreateNewAxisSp(oDestDoc.Part, "TransAxis" & oRoot.Products.Item(i).Name, False)
            oSel.Add oTransAx
            oSel.VisProperties.SetShow catVisPropertyNoShowAttr  'set noshow
            oSel.Clear
           
            arrOrg(0) = arrResPos(9)
            arrOrg(1) = arrResPos(10)
            arrOrg(2) = arrResPos(11)
            oTransAx.PutOrigin arrOrg
           
            arrVX(0) = arrResPos(0)
            arrVX(1) = arrResPos(1)
            arrVX(2) = arrResPos(2)
            oTransAx.PutXAxis arrVX
           
            arrVY(0) = arrResPos(3)
            arrVY(1) = arrResPos(4)
            arrVY(2) = arrResPos(5)
            oTransAx.PutYAxis arrVY
           
            arrVZ(0) = arrResPos(6)
            arrVZ(1) = arrResPos(7)
            arrVZ(2) = arrResPos(8)
            oTransAx.PutZAxis arrVZ
           
            Set oRefRefAx = oDestDoc.Part.CreateReferenceFromObject(oRefAx)
            Set oRefTransAx = oDestDoc.Part.CreateReferenceFromObject(oTransAx)
           
            Set oP = oProdItem.ReferenceProduct.Parent.Part
           
            For n = 1 To oP.Bodies.Count
              If oP.Bodies.Item(n).InBooleanOperation = False Then    'if not root body, skip
                  If oP.Bodies.Item(n).Shapes.Count <> 0 Then          'if bodies are empty, skip
                    If oP.IsUpToDate(oP.Bodies.Item(n)) = False Then  'if not up-to-date
                        oP.UpdateObject oP.Bodies.Item(n)              'update the body
                        DoEvents                                        'just in case
                    End If
                       
                    oSel.Add oP.Bodies.Item(n)
                    oSel.Copy
                    oSel.Clear

                    Set oDestSel = oDestDoc.Selection
                    oDestSel.Clear
                    oDestSel.Add oDestDoc.Part
                    oDestSel.PasteSpecial "CATPrtResultWithOutLink"
                    DoEvents
                    oDestSel.Clear
                    strNewBody = oRoot.Products.Item(i).Name & "/" & oP.Bodies.Item(n).Name ' & "//" & strCoord
                    oDestDoc.Part.Bodies.Item(oDestDoc.Part.Bodies.Count).Name = strNewBody
'                    Debug.Print oProdItem.Name, oP.Bodies.Item(n).Name, oP.IsUpToDate(oP.Bodies.Item(n)), showstate
                    Set oAxisToAxis = oDestDoc.Part.ShapeFactory.AddNewAxisToAxis2(oRefRefAx, oRefTransAx)
                    iBodyCount = iBodyCount + 1
                  End If
              End If
            Next
  '---------------------------------------------------------------------------------------------------
        Else
            'other
        End If
      End If
  Next
End Sub

Function CreateNewPart(strPNumber As String, strDescriptor As String) As PartDocument
  Dim oADPDoc As PartDocument
  Dim oADProd As Product
 
  Set oADPDoc = CATIA.Documents.Add("Part")          'create new part
  Set oADProd = CATIA.ActiveDocument.Product
  oADProd.PartNumber = strPNumber                'change partnumber
  oADProd.DescriptionRef = strDescriptor        'add descriptor
  CATIA.ActiveDocument.Part.Update                'update
  CATIA.StatusBar = "Creating New Part!"
  Set CreateNewPart = oADPDoc
End Function

Function CreateNewAxisSp(oParent As Part, strAxisName As String, Optional iCurr As Boolean = True, Optional iAxType As CATAxisSystemMainType = catAxisSystemStandard) As AxisSystem
'ToDo
'Fehler abfangen: bei bereits vorhandenem Part gleichen namens in der session

  Dim oAxSyst As AxisSystem
     
  Set oAxSyst = oParent.AxisSystems.Add()
  oParent.UpdateObject oAxSyst
  oAxSyst.Type = iAxType
  oAxSyst.IsCurrent = iCurr
  oAxSyst.Name = strAxisName
  oParent.Update
  Set CreateNewAxisSp = oAxSyst
End Function

' ***********************************************************************
'
' Purpose:  Define the product of two matrix.
'
' Inputs :  matrix1  Array      array corresponding to the first matrix
'          matrix2  Array      array corresponding to the second matrix
'
' Outputs:  res      Array      array corresponding to the product
'
' ***********************************************************************
' Borrowed from Dassault macro
Public Sub MatrixProduct(ByVal matrix1, ByVal matrix2, ByRef res)

  Dim a(11)
  Dim b(11)
  Dim i As Integer
  For i = 0 To 11
    a(i) = matrix1(i)
    b(i) = matrix2(i)
  Next
 
  res(0) = a(0) * b(0) + a(1) * b(3) + a(2) * b(6)
  res(3) = a(3) * b(0) + a(4) * b(3) + a(5) * b(6)
  res(6) = a(6) * b(0) + a(7) * b(3) + a(8) * b(6)
  res(1) = a(0) * b(1) + a(1) * b(4) + a(2) * b(7)
  res(4) = a(3) * b(1) + a(4) * b(4) + a(5) * b(7)
  res(7) = a(6) * b(1) + a(7) * b(4) + a(8) * b(7)
  res(2) = a(0) * b(2) + a(1) * b(5) + a(2) * b(8)
  res(5) = a(3) * b(2) + a(4) * b(5) + a(5) * b(8)
  res(8) = a(6) * b(2) + a(7) * b(5) + a(8) * b(8)
  res(9) = a(9) * b(0) + a(10) * b(3) + a(11) * b(6) + b(9)
  res(10) = a(9) * b(1) + a(10) * b(4) + a(11) * b(7) + b(10)
  res(11) = a(9) * b(2) + a(10) * b(5) + a(11) * b(8) + b(11)

End Sub


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

gunngir
Mitglied
Technischer Produktdesigner


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

Beiträge: 17
Registriert: 17.06.2014

Catia V5R19 SP9 64Bit

erstellt am: 02. Mrz. 2015 08: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 Nur für joehz 10 Unities + Antwort hilfreich

Wow danke, genau das wonach ich gesucht habe   

Das Makro funktioniert, auch bei großen Baugruppen.

Danke dafür!

(auch wenn ich die Logik des Makros noch nicht 100%ig verstanden habe, da Bool'sche Operationen und eine Matrix noch Neuland sind.)

aber vielleicht kommt das noch *hust*

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: 02. Mrz. 2015 11:44    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 gunngir,

ich hab noch zwei Änderungen vorgenommen,die ich Dir nicht vorenthalten möchte.
Im Wesentlichen betrifft es die Benamsung der Bodies und die Fehlermeldung,
die dann auftritt, falls das AllCatPart schon existiert.

Ansonsten:
- Bool'sche Ops kommen nicht vor. Es wird nur abgefragt, ob der fragliche Body eventuell z.B. ein Abzugskörper ist.
- Die Matritzen-Routine hab ich von Dassault gekupfert. Die Vorgehensweise ist im Dassault-Macro
'DMUPstCopyPasteKeepAbsolutePositionSource' beschrieben.
- Das eigentlich tückische ist die Rekursion von RunTree.
- Gelegentlich fliegt das Macro aus der Kurve. Offenbar mag Catia wiederholte gleiche Workmode-Änweisungen nicht.
Abhilfe: Händisch Product auf 'RB-Click/Representations/Visualization Mode' setzen. Dann sollt's wieder klappen.

Enjoy,
Joe

Code:

Option Explicit
Const strVersion As String = "V1.1"
Const strMacroName As String = "Poor Man's ProductToPart"

Public iBodyCount As Integer          'counter for stats
Public oRefAx As AxisSystem            'Part Ref axis system,1/1/1;0/0/0
Public oDestDoc As PartDocument        'destinaton for allcatpart

Sub CatMain()
  Dim oRootProd As Product
  Dim oSourceWindow As Window
  Dim oDestWindow As Window
  Dim arrRootPos(11)
  Dim tmStart As Date
  Dim tmEnd As Date

  tmStart = Time$
  iBodyCount = 0

  Set oSourceWindow = CATIA.ActiveWindow
  Set oRootProd = GetRootProd
  If oRootProd Is Nothing Then End
  Set oDestDoc = CreateNewPart(oRootProd.Name & "_AllCatPart", "AllCatPart aus " & oRootProd.Name)  'create destination part
  Set oDestWindow = CATIA.Windows.Item(CATIA.Windows.Count)
  Set oRefAx = CreateNewAxisSp(oDestDoc.Part, "RefAxis")
  oSourceWindow.Activate

  arrRootPos(0) = 1                                                'reset axis cooords to
  arrRootPos(1) = 0                                                'standard r/h system
  arrRootPos(2) = 0
  arrRootPos(3) = 0
  arrRootPos(4) = 1
  arrRootPos(5) = 0
  arrRootPos(6) = 0
  arrRootPos(7) = 0
  arrRootPos(8) = 1
  arrRootPos(9) = 0
  arrRootPos(10) = 0
  arrRootPos(11) = 0

  CATIA.RefreshDisplay = False
  CATIA.DisplayFileAlerts = False
  CATIA.HSOSynchronized = False

  RunTree oRootProd, arrRootPos(), ""

  oDestDoc.Part.Update

  CATIA.HSOSynchronized = True
  CATIA.DisplayFileAlerts = True
  oDestWindow.Activate
  CATIA.StartCommand "Fit All In"
  DoEvents
  CATIA.RefreshDisplay = True
  CATIA.StatusBar = "Macro finished. "

  tmEnd = Time$
  MsgBox "Start: " & tmStart & vbCrLf _
        & "Ende: " & tmEnd & vbCrLf _
        & iBodyCount & " Bodies copied.", _
        vbOKOnly Or vbInformation, strMacroName & "/" & strVersion
End Sub

Function GetRootProd() As Product
  Dim oSel As Selection

  Set oSel = CATIA.ActiveDocument.Selection
  If oSel.Count2 = 1 Then
      If oSel.Item(1).Type = "Product" Then
        Set GetRootProd = oSel.Item2(1).Value
      Else
        MsgBox "This macro needs a product to work!" & vbCr & "Exiting macro ...", vbOKOnly Or vbCritical, "GetRootProd - " & strMacroName & "/" & strVersion
      End If
  Else
      MsgBox "Select a product first!" & vbCr & "Exiting macro ...", vbOKOnly Or vbCritical, "GetRootProd - " & strMacroName & "/" & strVersion
      End
  End If

End Function
'---------------------------------------------------------------------------------------
' Procedure : RunTree
' Author    : jherzog
' Date      : 27.02.2015
' Time      : 18:49
' Languages : VBA 6.5
' V5-Release: V5R19/21
' Purpose  :
' Parms    : oRoot:          the root product from where the search begins
'          : arrRootProd():  array holding axis coordinates
' Ret. Value: -
'
' Syntax    : RunTree oRootProd, arrRootPos()
'
' Prereqs  :
' Remarks  :
'---------------------------------------------------------------------------------------
' ChangeLog : 28.02.2015  : body names changed
'
'
'
'
'
'
'
'---------------------------------------------------------------------------------------
Sub RunTree(oRoot As Product, arrRootProd(), strNewBodyPath As String)
  Dim i As Integer
  Dim n As Integer
  Dim arrInv(11)                                        'inverse pos
  Dim arrPos(11)                                        'part pos
  Dim arrProdPos(11)                                    'prod pos
  Dim arrResPos(11)                                    'result from part matrix multiply
  Dim arrResProdPos(11)                                'result from product matrix multiply
  Dim oProdItem As Object 'Product
  Dim strCoord As String
  Dim oP As Part
  Dim oSel As Selection                                'source selection
  Dim oDestSel As Selection                            'destination selection
  Dim showstate As CatVisPropertyShow
  Dim strNewBody As String                              'name of created body
  Dim oTransAx As Object 'AxisSystem                    'Dest Ax Sys for catpart Ax2Ax translation
  Dim arrOrg(2)                                        'PutOrigin - array
  Dim arrVX(2)                                          'PutXAxis - array
  Dim arrVY(2)                                          'PutYAxis - array
  Dim arrVZ(2)                                          'PutZAxis - array
  Dim oRefRefAx As Reference                            'Ref element source
  Dim oRefTransAx As Reference                          'Ref element dest
  Dim oAxisToAxis As ShapeFactory                      'translate op

'---------------------------------------------------------------------------------------------------
' TODO:
' - rearrange code within loops/If-Else-cases
' - shapes.count reicht nicht aus; bodies mit aufgeboolten leeren bodies werden nicht ausgeschlossen!
'(- alle bodies aus allcatpart in neues catpart kopieren; -> die achsen und translates verschwinden;)
' - arrays umbenennen
' - untersuchen, ob instanzen komplett kopiert werden können (Strategie?)
' - body-translation als datum/blitz?
' - closed shells berücksichtigen! (-> geosets checken)
' - achsensysteme kopieren
'---------------------------------------------------------------------------------------------------

  Set oSel = CATIA.ActiveDocument.Selection
  Set oDestSel = oDestDoc.Selection
 
  For i = 1 To oRoot.Products.Count
'    MsgBox oRoot.Products.Item(i).Name
      Set oProdItem = oRoot.Products.Item(i)
   
      oSel.Clear
      oSel.Add oProdItem                                          'check if noshow
      oSel.VisProperties.GetShow showstate                        'is the part visible, go on
      oSel.Clear
   
      If showstate = catVisPropertyShowAttr Then                  'if noshow, skip
        oProdItem.ApplyWorkMode (DEFAULT_MODE)                  'set work mode to default
        'PRODUCT LEVEL
        If TypeName(oProdItem.ReferenceProduct.Parent) = "ProductDocument" Then
            oProdItem.position.GetComponents arrProdPos          'get zb axis coords if in zb
            'multiply new array with old array; FIRST arg must be NEW array!
            MatrixProduct arrProdPos, arrRootProd, arrResProdPos  'build array product
            RunTree oProdItem, arrResProdPos, strNewBodyPath      'reenter one level down
        'PART LEVEL
        ElseIf TypeName(oProdItem.ReferenceProduct.Parent) = "PartDocument" Then
          'calc displacement
            oProdItem.position.GetComponents arrPos
         
            'combine axis position arrays
            MatrixProduct arrPos, arrRootProd, arrResPos          'build resulting array (NEW,OLD,RESULT)!
            'create axis according to position array; this defines the translation for the current part
            Set oTransAx = CreateNewAxisSp(oDestDoc.Part, "TransAxis" & oRoot.Products.Item(i).Name, False)
            oSel.Add oTransAx
            oSel.VisProperties.SetShow catVisPropertyNoShowAttr  'set noshow
            oSel.Clear
         
            arrOrg(0) = arrResPos(9)
            arrOrg(1) = arrResPos(10)
            arrOrg(2) = arrResPos(11)
            oTransAx.PutOrigin arrOrg
         
            arrVX(0) = arrResPos(0)
            arrVX(1) = arrResPos(1)
            arrVX(2) = arrResPos(2)
            oTransAx.PutXAxis arrVX
         
            arrVY(0) = arrResPos(3)
            arrVY(1) = arrResPos(4)
            arrVY(2) = arrResPos(5)
            oTransAx.PutYAxis arrVY
         
            arrVZ(0) = arrResPos(6)
            arrVZ(1) = arrResPos(7)
            arrVZ(2) = arrResPos(8)
            oTransAx.PutZAxis arrVZ
          'create references for axistoaxis
            Set oRefRefAx = oDestDoc.Part.CreateReferenceFromObject(oRefAx)
            Set oRefTransAx = oDestDoc.Part.CreateReferenceFromObject(oTransAx)
         
          'body handler
            Set oP = oProdItem.ReferenceProduct.Parent.Part
         
            For n = 1 To oP.Bodies.Count
              If oP.Bodies.Item(n).InBooleanOperation = False Then    'if not root body, skip
                  If oP.Bodies.Item(n).Shapes.Count <> 0 Then          'if bodies are empty, skip
                    If oP.IsUpToDate(oP.Bodies.Item(n)) = False Then  'if not up-to-date
                        oP.UpdateObject oP.Bodies.Item(n)              'update the body
                        DoEvents                                        'just in case
                    End If
                     
                    oSel.Add oP.Bodies.Item(n)
                    oSel.Copy
                    oSel.Clear

                    Set oDestSel = oDestDoc.Selection
                    oDestSel.Clear
                    oDestSel.Add oDestDoc.Part
                    oDestSel.PasteSpecial "CATPrtResultWithOutLink"
                    DoEvents
                    oDestSel.Clear
                    strNewBody = oProdItem.Name & "/" & oP.Bodies.Item(n).Name
                    oDestDoc.Part.Bodies.Item(oDestDoc.Part.Bodies.Count).Name = strNewBodyPath & strNewBody
'                    Debug.Print oProdItem.Name, oP.Bodies.Item(n).Name, oP.IsUpToDate(oP.Bodies.Item(n)), showstate
                    Set oAxisToAxis = oDestDoc.Part.ShapeFactory.AddNewAxisToAxis2(oRefRefAx, oRefTransAx)
                    iBodyCount = iBodyCount + 1
                  End If
              End If
            Next
  '---------------------------------------------------------------------------------------------------
        Else
            'other
        End If
      End If
  Next
  'shorten path on level exit
  On Error Resume Next              'first root causes error, since not in path
  strNewBodyPath = Left$(strNewBodyPath, Len(strNewBodyPath) - Len(oRoot.Name) - 1)
  On Error GoTo 0

End Sub

'---------------------------------------------------------------------------------------
' Procedure : CreateNewPart
' Author    : jherzog
' Date      : 27.02.2015
' Time      : 18:33
' Languages : VBA 6.5
' V5-Release: V5R19/21
' Purpose  : Create a new CATPart
' Parms    : strPNummber    : CatPart name
'          : strDescriptor  : Text entered in Properties/Description
' Ret. Value: the new partdoc object
'
' Syntax    : set oPartNew = CreateNewPart("TestPart","New test part")
'
' Prereqs  :
' Remarks  : Error 'Unable to change Part number' is none critical
'---------------------------------------------------------------------------------------
' ChangeLog : 28.02.2015  : error handling added
'
'---------------------------------------------------------------------------------------
Function CreateNewPart(strPNumber As String, strDescriptor As String) As PartDocument
  Dim oADPDoc As PartDocument
  Dim oADProd As Product
 
  On Error GoTo CreateNewPart_Error

  Set oADPDoc = CATIA.Documents.Add("Part")          'create new part
  Set oADProd = CATIA.ActiveDocument.Product
  oADProd.PartNumber = strPNumber                'change partnumber
  oADProd.DescriptionRef = strDescriptor        'add descriptor
  CATIA.ActiveDocument.Part.Update                'update
  CATIA.StatusBar = "Creating New Part!"
  Set CreateNewPart = oADPDoc

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

  Select Case Err.Number
'      Case 438
      Case -2147467259                            'part already exists in session
        MsgBox "Unable to set PartNumber!" & vbCrLf & "Rename when saving!", _
            vbOKOnly Or vbInformation, "CreateNewPart"
        Resume Next
      Case Else
        errMsg = Err.Number & ": " & Err.Description & " in CreateNewPart"
        errRet = MsgBox(errMsg, vbOKOnly, "CreateNewPart")
  End Select

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

Function CreateNewAxisSp(oParent As Part, strAxisName As String, Optional iCurr As Boolean = True, Optional iAxType As CATAxisSystemMainType = catAxisSystemStandard) As AxisSystem

  Dim oAxSyst As AxisSystem
   
  Set oAxSyst = oParent.AxisSystems.Add()
  oParent.UpdateObject oAxSyst
  oAxSyst.Type = iAxType
  oAxSyst.IsCurrent = iCurr
  oAxSyst.Name = strAxisName
  oParent.Update
  Set CreateNewAxisSp = oAxSyst
End Function

' ***********************************************************************
'
' Purpose:  Define the product of two matrix.
'
' Inputs :  matrix1  Array      array corresponding to the first matrix
'          matrix2  Array      array corresponding to the second matrix
'
' Outputs:  res      Array      array corresponding to the product
'
' ***********************************************************************
' Borrowed from Dassault macro
Public Sub MatrixProduct(ByVal matrix1, ByVal matrix2, ByRef res)

  Dim a(11)
  Dim b(11)
  Dim i As Integer
  For i = 0 To 11
    a(i) = matrix1(i)
    b(i) = matrix2(i)
  Next

  res(0) = a(0) * b(0) + a(1) * b(3) + a(2) * b(6)
  res(3) = a(3) * b(0) + a(4) * b(3) + a(5) * b(6)
  res(6) = a(6) * b(0) + a(7) * b(3) + a(8) * b(6)
  res(1) = a(0) * b(1) + a(1) * b(4) + a(2) * b(7)
  res(4) = a(3) * b(1) + a(4) * b(4) + a(5) * b(7)
  res(7) = a(6) * b(1) + a(7) * b(4) + a(8) * b(7)
  res(2) = a(0) * b(2) + a(1) * b(5) + a(2) * b(8)
  res(5) = a(3) * b(2) + a(4) * b(5) + a(5) * b(8)
  res(8) = a(6) * b(2) + a(7) * b(5) + a(8) * b(8)
  res(9) = a(9) * b(0) + a(10) * b(3) + a(11) * b(6) + b(9)
  res(10) = a(9) * b(1) + a(10) * b(4) + a(11) * b(7) + b(10)
  res(11) = a(9) * b(2) + a(10) * b(5) + a(11) * b(8) + b(11)

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: 12. Mrz. 2015 18:59    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

Nachfolgend die letzte Version.

Hinzugekommen ist die Behandlung von Wireframe-Elementen(HybridBodies/Hybridshapes), sowie von Achsensystemen.
Meine Versuche, die AxisToAxis-Ops durch nochmaliges kopieren in ein neues CatPart zu eliminieren, waren nicht erfolgreich.
Händisch möglich, aber makro-technisch?

Enjoy,
Joe

Code:

Option Explicit
Const strVersion As String = "V1.3"
Const strMacroName As String = "Poor Man's ProductToPart"

Public iBodyCount As Integer           'counter for stats
Public oRefAx As AxisSystem            'Part Ref axis system,1/1/1;0/0/0
Public oTempDoc As PartDocument        'intermediate destinaton for allcatpart

'---------------------------------------------------------------------------------------
' Procedure : CatMain
' Author    : jherzog
' Date      : 01.03.2015
' Time      : 14:48
' Languages : VBA 6.5
' V5-Release: V5R19/21
' Purpose   : Create Part From Product(s)
' Parms     : -
' Ret. Value: -
'
' Syntax    : CatMain
'
' Prereqs   : Loaded, selected product containing geometry
' Remarks   :
'---------------------------------------------------------------------------------------
Sub CATMain()
'---------------------------------------------------------------------------------------
' ToDo:
' - Sort bodies(StartCommand: Reorder Children; sort similar to product sort
' - sortierung: array aus bodies + geosets erstellen, sortieren und in der reihenfolge
'   in ein neues part kopieren; dadurch sortierung und keine transformationen mehr;
' - im neuen part überflüssige Elemente im NoShow löschen
'
'
'---------------------------------------------------------------------------------------
   Dim oRootProd As Product
   Dim oSourceWindow As Window
   Dim oTempWindow As Window
   Dim arrRootPos(11)
   Dim tmStart As Date
   Dim tmEnd As Date
   Dim oSel As Selection
   Dim n As Integer
  
   tmStart = Time$
   iBodyCount = 0
  
   Set oSourceWindow = CATIA.ActiveWindow
   Set oRootProd = GetRootProd
   If oRootProd Is Nothing Then End
   'create temp part
   Set oTempDoc = CreateNewPart(oRootProd.Name & "_TempAllCatPart", _
      "AllCatPart aus " & oRootProd.Name, True, True)
   Set oTempWindow = CATIA.Windows.Item(CATIA.Windows.Count)
   Set oRefAx = CreateNewAxisSp(oTempDoc.Part, "RefAxis")
   oSourceWindow.Activate
   DoEvents
  
   InitArray arrRootPos()

   CATIA.RefreshDisplay = False
   CATIA.DisplayFileAlerts = False
   CATIA.HSOSynchronized = False
  
   RunTree oRootProd, arrRootPos(), ""
  
'   CleanUp
   oTempDoc.Part.Update
  
   CATIA.RefreshDisplay = True
   CATIA.HSOSynchronized = True
   CATIA.DisplayFileAlerts = True
   oTempWindow.Activate
  
   CATIA.StartCommand "Fit All In"
   DoEvents
   CATIA.StartCommand "Collapse All"
   DoEvents
   CATIA.RefreshDisplay = True
   DoEvents
   CATIA.StatusBar = "Macro finished. "

   tmEnd = Time$
   MsgBox "Start: " & tmStart & vbCrLf _
        & "Ende: " & tmEnd & vbCrLf _
        & iBodyCount & " Bodies copied.", _
        vbOKOnly Or vbInformation, strMacroName & "/" & strVersion
End Sub

Function GetRootProd() As Product
   Dim oSel As Selection

   Set oSel = CATIA.ActiveDocument.Selection
   If oSel.Count2 = 1 Then
      If oSel.Item(1).Type = "Product" Then
         Set GetRootProd = oSel.Item2(1).Value
      Else
         MsgBox "This macro needs a product to work!" & vbCr & "Exiting macro ...", _
            vbOKOnly Or vbCritical, "GetRootProd - " & strMacroName & "/" & strVersion
      End If
   Else
      MsgBox "Select a product first!" & vbCr & "Exiting macro ...", _
         vbOKOnly Or vbCritical, "GetRootProd - " & strMacroName & "/" & strVersion
      End
   End If

End Function

'---------------------------------------------------------------------------------------
' Procedure : RunTree
' Author    : jherzog
' Date      : 27.02.2015
' Time      : 18:49
' Languages : VB6 Pro SP6
' V5-Release: V5R19/21
' Purpose   :
' Parms     : oRoot:          the root product from where the search begins
'           : arrRootProd():  array holding axis coordinates
' Ret. Value: -
'
' Syntax    : RunTree oRootProd, arrRootPos()
'
' Prereqs   :
' Remarks   :
'---------------------------------------------------------------------------------------
' ChangeLog : 28.02.2015   : body names changed
'           : 02.03.2015   : added GeoSets handler for Surfs, Crvs, Pts etc.
'           : 03.03.2015   : added Axis handler
'           : 08.03.2015   : SetAxisComp, SetHide, DoPasteSpecial, DoCopy, DelObject,
'           :              : AreShapesInActive, IsShow, GetBodySetsArray added
'           : 09.03.2015   : Debugging; CleanUp added; added Bodies/IsShow
'
'
'---------------------------------------------------------------------------------------
Sub RunTree(oRoot As Product, arrRootProd(), strNewBodyPath As String)
   Dim i As Integer
   Dim n As Integer
   Dim m As Integer
   Dim arrInv(11)                                        'inverse pos
   Dim arrPos(11)                                        'part pos
   Dim arrProdPos(11)                                    'prod pos
   Dim arrResPos(11)                                     'result from part matrix multiply
   Dim arrResProdPos(11)                                 'result from product matrix multiply
   Dim oProdItem As Object 'Product
   Dim strCoord As String
   Dim oP As Part
   Dim oHSs As HybridShapes
   Dim oDestSet As HybridBody                             'Dest Geoset
   Dim oSel As Selection                                 'source selection
   Dim strNewBody As String                              'name of created body
   Dim oTransAx As Object 'AxisSystem                    'Dest Ax Sys for catpart Ax2Ax translation
   Dim oRefRefAx As Reference                            'Ref element source
   Dim oRefTransAx As Reference                          'Ref element dest
   Dim oRefHBody As Reference                            'Ref of hybrid body
   Dim oAxisToAxis As ShapeFactory                       'translate op bodies
   Dim oHSAxisToAxis As HybridShapeAxisToAxis            'translate op hybridbodies
   Dim bAtLeastOne As Boolean                            'flag for erasing set
'---------------------------------------------------------------------------------------
' TODO:
' - rearrange code within loops/If-Else-cases
' - arrays umbenennen
' - untersuchen, ob instanzen komplett kopiert werden können (Strategie?)
' - body-translation als datum/blitz?
' - fehlerbehandlung '+'
' - alle bodies in endgültiges catpart kopieren
'---------------------------------------------------------------------------------------
  
   On Error GoTo RunTree_Error

   Set oSel = CATIA.ActiveDocument.Selection
  
   For i = 1 To oRoot.Products.Count
'     MsgBox oRoot.Products.Item(i).Name
      Set oProdItem = oRoot.Products.Item(i)
     
      If IsShow(oSel, oProdItem) Then                             'if noshow, skip
         oProdItem.ApplyWorkMode (DESIGN_MODE)                    'set work mode
         DoEvents
'---------------------------------------------------------------------------------------
         'PRODUCT LEVEL
         If TypeName(oProdItem.ReferenceProduct.Parent) = "ProductDocument" Then
            oProdItem.position.GetComponents arrProdPos     'get zb axis coords if in zb
            'multiply new array with old array; FIRST arg must be NEW array!
            MatrixProduct arrProdPos, arrRootProd, arrResProdPos  'build array product
            strNewBodyPath = strNewBodyPath & oProdItem.Name & "/"
            RunTree oProdItem, arrResProdPos, strNewBodyPath   'reenter one level down
'---------------------------------------------------------------------------------------
         'PART LEVEL
         ElseIf TypeName(oProdItem.ReferenceProduct.Parent) = "PartDocument" Then
            'calc displacement
            oProdItem.position.GetComponents arrPos
            'combine axis position arrays
            MatrixProduct arrPos, arrRootProd, arrResPos    'build resulting array (NEW,OLD,RESULT)!
            'create axis according to position array; this defines the translation for the current part
            Set oTransAx = CreateNewAxisSp(oTempDoc.Part, "TransAxis_" _
               & oRoot.Name & "_" & oRoot.Products.Item(i).Name, False)
           
            SetHide oSel, oTransAx, True     'set noshow
            SetAxisComp oTransAx, arrResPos  'change the axis to match displacement
           
            'create references for axistoaxis
            Set oRefRefAx = oTempDoc.Part.CreateReferenceFromObject(oRefAx)
            Set oRefTransAx = oTempDoc.Part.CreateReferenceFromObject(oTransAx)
           
'---------------------------------------------------------------------------------------
            'body handler
            Set oP = oProdItem.ReferenceProduct.Parent.Part
            For n = 1 To oP.Bodies.Count                                'go through the bodies
               If oP.Bodies.Item(n).InBooleanOperation = False Then     'if not root body, skip
                  If IsShow(oSel, oP.Bodies.Item(n)) Then               'if noshow skip
                     If oP.Bodies.Item(n).Shapes.Count <> 0 Then        'if bodies are empty, skip
                        If AreShapesInActive(oP, oP.Bodies.Item(n).Name) = False Then  'at least one shape active
                           If oP.IsUpToDate(oP.Bodies.Item(n)) = False Then 'if not up-to-date
                              oP.UpdateObject oP.Bodies.Item(n)         'update the body
                              DoEvents                                  'just in case
                           End If
                          
                           DoCopy oSel, oP.Bodies.Item(n)
                           DoPasteSpecial oSel, oTempDoc.Part, "CATPrtResultWithOutLink"
     
                           strNewBody = oProdItem.Name & "/" & oP.Bodies.Item(n).Name
                           oTempDoc.Part.Bodies.Item(oTempDoc.Part.Bodies.Count).Name = _
                              strNewBodyPath & strNewBody
                           Set oAxisToAxis = oTempDoc.Part.ShapeFactory.AddNewAxisToAxis2 _
                              (oRefRefAx, oRefTransAx)
                           iBodyCount = iBodyCount + 1
                        End If
                     End If
                  End If
               End If
            Next
'---------------------------------------------------------------------------------------
            'geoset handler; Pts, Crvs(=Lns), Plns, Surfs
            For n = 1 To oP.HybridBodies.Count
               Set oHSs = oP.HybridBodies.Item(n).HybridShapes
               If oHSs.Count <> 0 Then                                  'any shapes in the set?
                  If IsShow(oSel, oP.HybridBodies.Item(n)) Then         'if the hybridbody is show, create the set
                     Set oDestSet = CreateGeometricSet(oTempDoc.Part, _
                        strNewBodyPath & oProdItem.Name & "/" & oP.HybridBodies.Item(n).Name)
                     bAtLeastOne = False                                'init flag
                    
                     For m = 1 To oHSs.Count                            'walk thru shapes
                        If IsShow(oSel, oHSs.Item(m)) Then              'if the shape is show//value not empty
                           DoCopy oSel, oHSs.Item(m)                    'copy shape to clipboard
                           oSel.Clear
                           DoPasteSpecial oSel, oDestSet, "CATPrtResultWithOutLink" 'paste to dest part
                          
                           'create reference using last created hybridshape
                           Set oRefHBody = oTempDoc.Part.CreateReferenceFromObject _
                              (oDestSet.HybridShapes.Item(oDestSet.HybridShapes.Count))
                           Set oHSAxisToAxis = oTempDoc.Part.HybridShapeFactory.AddNewAxisToAxis _
                              (oRefHBody, oRefRefAx, oRefTransAx)
                           oHSAxisToAxis.VolumeResult = False
                           DoEvents
                           oDestSet.AppendHybridShape oHSAxisToAxis
                          
                           SetHide oSel, oDestSet.HybridShapes.Item _
                              (oDestSet.HybridShapes.Count - 1), True   'hide initial element
                           bAtLeastOne = True                           'at least one shape exists
                        End If
                     Next
                     If bAtLeastOne = False Then                        'if no shapes in hybridbody/geoset,
                        DelObject oSel, oDestSet                        'then delete set
                     Else
                        iBodyCount = iBodyCount + 1                     'inc counter
                     End If
                  End If
               End If
            Next
'---------------------------------------------------------------------------------------
            'achsensystem handler
            For n = 1 To oP.AxisSystems.Count
               If IsShow(oSel, oP.AxisSystems.Item(n)) Then             'check if noshow
                  DoCopy oSel, oP.AxisSystems.Item(n)                   'copy
                  oSel.Clear
                  DoPasteSpecial oSel, oTempDoc.Part, "CATPrtResultWithOutLink" 'paste as result

                  oTempDoc.Part.AxisSystems.Item(oTempDoc.Part.AxisSystems.Count).Name = _
                     "Axis_" & oRoot.Name & "_" & oRoot.Products.Item(i).Name _
                     & "/" & oP.AxisSystems.Item(n).Name
                  oTempDoc.Part.UpdateObject oTempDoc.Part.AxisSystems.Item _
                     (oTempDoc.Part.AxisSystems.Count)

                  Set oRefHBody = oTempDoc.Part.CreateReferenceFromObject _
                     (oTempDoc.Part.AxisSystems.Item(oTempDoc.Part.AxisSystems.Count))
                  Set oHSAxisToAxis = oTempDoc.Part.HybridShapeFactory.AddNewAxisToAxis _
                     (oRefHBody, oRefRefAx, oRefTransAx)
                  oHSAxisToAxis.VolumeResult = False
                  DoEvents
                  If oDestSet Is Nothing Then
                     Set oDestSet = CreateGeometricSet(oTempDoc.Part, "TranslSet")
                     iBodyCount = iBodyCount + 1                           'inc counter
                  End If
                  oDestSet.AppendHybridShape oHSAxisToAxis
                  SetHide oSel, oTempDoc.Part.AxisSystems.Item _
                     (oTempDoc.Part.AxisSystems.Count), True        'hide initial element
               End If
            Next
'---------------------------------------------------------------------------------------
         End If
      End If
   Next
'---------------------------------------------------------------------------------------
   'adjust path; causes error if strBodyPath = ""
   strNewBodyPath = Left$(strNewBodyPath, Len(strNewBodyPath) - Len(oRoot.Name) - 1)
Exit Sub
'---------------------------------------------------------------------------------------
RunTree_Error:
   Dim errMsg As String
   Dim errRet As VbMsgBoxResult

   Select Case Err.Number
       Case 5                                'invalid procedure call or argument
         Resume Next                         'ausgelöst durch strNewBodyPath = Left$(...
'       Case 438
'       Case -2147467259
       Case Else
         errMsg = Err.Number & ": " & Err.Description & " in procedure RunTree"
         errRet = MsgBox(errMsg, vbOKOnly, "RunTree")
   End Select

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

End Sub

'---------------------------------------------------------------------------------------
' Procedure : CreateNewPart
' Author    : jherzog
' Date      : 27.02.2015
' Time      : 18:33
' Languages : VBA 6.5
' V5-Release: V5R19/21
' Purpose   : Create a new CATPart
' Parms     : strPNummber     : CatPart name
'           : strDescriptor   : Text entered in Properties/Description
'           : bNoGeoSet1      : True = Do not create Geometric Set.1
'           : bHideSysPlanes  : True = Hide Origin Planes
' Ret. Value: the new partdoc object
'
' Syntax    : set oPartNew = CreateNewPart("TestPart","New test part")
'
' Prereqs   :
' Remarks   : Error 'Unable to change Part number' is none critical
'---------------------------------------------------------------------------------------
' ChangeLog : 02.03.2015   : added Option bNoGeoSet1
'                          : added Option bHideSysPlanes
'---------------------------------------------------------------------------------------
Function CreateNewPart(strPNumber As String, strDescriptor As String, _
    Optional bHideSysPlanes As Boolean = False, _
    Optional bNoGeoSet1 As Boolean = False) As PartDocument
   Dim oADPDoc As PartDocument
   Dim oADProd As Product
   Dim oSel As Selection
  
   On Error GoTo CreateNewPart_Error

   Set oADPDoc = CATIA.Documents.Add("Part")          'create new part
   Set oADProd = CATIA.ActiveDocument.Product
   oADProd.PartNumber = strPNumber                    'change partnumber
   oADProd.DescriptionRef = strDescriptor             'add descriptor
   If bHideSysPlanes = True Then
      Set oSel = CATIA.ActiveDocument.Selection
      oSel.Add CATIA.ActiveDocument.Part.OriginElements.PlaneXY
      oSel.Add CATIA.ActiveDocument.Part.OriginElements.PlaneYZ
      oSel.Add CATIA.ActiveDocument.Part.OriginElements.PlaneZX
      oSel.VisProperties.SetShow catVisPropertyNoShowAttr
      oSel.Clear
   End If
  
   If bNoGeoSet1 = True Then
      Set oSel = CATIA.ActiveDocument.Selection
      oSel.Add CATIA.ActiveDocument.Part.HybridBodies.Item("Geometrical Set.1")
      oSel.Delete
      oSel.Clear
   End If
   CATIA.ActiveDocument.Part.Update                   'update
   CATIA.StatusBar = "Creating New Part!"
   Set CreateNewPart = oADPDoc

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

   Select Case Err.Number
'      Case 438
      Case -2147467259                             'part already exists in session
         MsgBox "Unable to set PartNumber!" & vbCrLf & "Rename when saving!", _
            vbOKOnly Or vbInformation, "CreateNewPart"
         Resume Next
      Case Else
         errMsg = Err.Number & ": " & Err.Description & " in CreateNewPart"
         errRet = MsgBox(errMsg, vbOKOnly, "CreateNewPart")
   End Select

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

Function CreateNewAxisSp(oParent As Part, strAxisName As String, _
   Optional iCurr As Boolean = True, _
   Optional iAxType As CATAxisSystemMainType = catAxisSystemStandard) As AxisSystem
   Dim oAxSyst As AxisSystem
     
   Set oAxSyst = oParent.AxisSystems.Add()
   oParent.UpdateObject oAxSyst
   oAxSyst.Type = iAxType
   oAxSyst.IsCurrent = iCurr
   oAxSyst.Name = strAxisName
   oParent.Update
   Set CreateNewAxisSp = oAxSyst
End Function

Function CreateGeometricSet(oParent As Part, strGeoSetName As String) As HybridBody
   Dim HBs As HybridBodies
   Dim gsNew As HybridBody

   Set HBs = oParent.HybridBodies
   Set gsNew = HBs.Add                                      'add to list
   gsNew.Name = strGeoSetName                               'rename
   Set CreateGeometricSet = gsNew
   CATIA.StatusBar = "Creating New Set!"
End Function
Sub SetAxisComp(oAxis As Object, arrComp)                'modify axis components
'   Dim oAxis As Object 'AxisSystem                      'Dest Ax Sys for catpart Ax2Ax translation
   Dim arrOrg(2)                                         'PutOrigin - array
   Dim arrVX(2)                                          'PutXAxis - array
   Dim arrVY(2)                                          'PutYAxis - array
   Dim arrVZ(2)                                          'PutZAxis - array
  
  
   arrOrg(0) = arrComp(9)
   arrOrg(1) = arrComp(10)
   arrOrg(2) = arrComp(11)
   oAxis.PutOrigin arrOrg
  
   arrVX(0) = arrComp(0)
   arrVX(1) = arrComp(1)
   arrVX(2) = arrComp(2)
   oAxis.PutXAxis arrVX
  
   arrVY(0) = arrComp(3)
   arrVY(1) = arrComp(4)
   arrVY(2) = arrComp(5)
   oAxis.PutYAxis arrVY
  
   arrVZ(0) = arrComp(6)
   arrVZ(1) = arrComp(7)
   arrVZ(2) = arrComp(8)
   oAxis.PutZAxis arrVZ

End Sub

Sub SetHide(sSel As Selection, oItem As Object, bHide As Boolean) 'set show/noshow
   sSel.Clear
   sSel.Add oItem
   If bHide = True Then
      sSel.VisProperties.SetShow catVisPropertyNoShowAttr
   Else
      sSel.VisProperties.SetShow catVisPropertyShowAttr
   End If
   sSel.Clear
End Sub
Sub DoPasteSpecial(sSel As Selection, oItem As Object, strPasteHow As String)
   sSel.Add oItem
   sSel.PasteSpecial strPasteHow
   sSel.Clear
End Sub

Sub DoCopy(sSel As Selection, oItem As Object)                 'copy one object
      sSel.Clear
      sSel.Add oItem
      sSel.Copy
End Sub

Sub DelObject(sSel As Selection, oItem As Object)              'delete one object
   sSel.Clear
   sSel.Add oItem
   sSel.Delete
   sSel.Clear
End Sub

Function AreShapesInActive(oParent As Part, strBody As String) As Boolean
   Dim n As Integer
  
   AreShapesInActive = True
   For n = 1 To oParent.Bodies.Item(strBody).Shapes.Count
      If oParent.IsInactive(oParent.Bodies.Item(strBody).Shapes.Item(n)) = False Then
         AreShapesInActive = False
         Exit For
      End If
   Next
End Function

Function IsShow(sSel As Selection, oItem As Object) As Boolean 'show or noshow?
   Dim showstate As CatVisPropertyShow
  
   sSel.Clear
   sSel.Add oItem                                              'check if noshow
   sSel.VisProperties.GetShow showstate                        'is the part visible, go on
   sSel.Clear
   If showstate = catVisPropertyShowAttr Then
      IsShow = True
   Else
      IsShow = False
   End If
  
End Function

Sub CleanUp()                                                  'delete empty bodies
   Dim n As Integer
   Dim oSel As Selection
  
   Set oSel = CATIA.ActiveDocument.Selection
  
   For n = 1 To oTempDoc.Part.Bodies.Count
      If oTempDoc.Part.Bodies.Item(n).Shapes.Count = 0 _
         And Not oTempDoc.Part.Bodies.Item(n) Is oTempDoc.Part.MainBody Then
         DelObject oSel, oTempDoc.Part.Bodies.Item(n)
      End If
   Next
End Sub

Sub InitArray(arrPos)
   arrPos(0) = 1                                                 'init axis cooords to
   arrPos(1) = 0                                                 'standard r/h system
   arrPos(2) = 0
   arrPos(3) = 0
   arrPos(4) = 1
   arrPos(5) = 0
   arrPos(6) = 0
   arrPos(7) = 0
   arrPos(8) = 1
   arrPos(9) = 0
   arrPos(10) = 0
   arrPos(11) = 0
End Sub

' QuickSort-Algorithmus
' Autor:   Dieter Otter
' www.tools4vb.de
'
' vSort() : zu sortierendes Array
' lngStart, lngEnd: zu sortierender Bereich
' ==========================================
Public Sub QuickSort(vSort As Variant, _
  Optional ByVal lngStart As Variant, _
  Optional ByVal lngEnd As Variant)

   ' Wird die Bereichsgrenze nicht angegeben,
   ' so wird das gesamte Array sortiert
  
   If IsMissing(lngStart) Then lngStart = LBound(vSort)
   If IsMissing(lngEnd) Then lngEnd = UBound(vSort)
  
   Dim i As Long
   Dim j As Long
   Dim H As Variant
   Dim X As Variant
  
   i = lngStart
   j = lngEnd
   X = vSort((lngStart + lngEnd) / 2)
  
   ' Array aufteilen
   Do
  
      While (vSort(i) < X)
         i = i + 1
      Wend
      While (vSort(j) > X)
         j = j - 1
      Wend
     
      If (i <= j) Then
         ' Wertepaare miteinander tauschen
         H = vSort(i)
         vSort(i) = vSort(j)
         vSort(j) = H
         i = i + 1
         j = j - 1
      End If
   Loop Until (i > j)
  
   ' Rekursion (Funktion ruft sich selbst auf)
   If (lngStart < j) Then QuickSort vSort, lngStart, j
   If (i < lngEnd) Then QuickSort vSort, i, lngEnd
End Sub

' ***********************************************************************
'
' Purpose:  Define the product of two matrix.
'
' Inputs :  matrix1  Array       array corresponding to the first matrix
'           matrix2  Array       array corresponding to the second matrix
'
' Outputs:  res      Array       array corresponding to the product
'
' ***********************************************************************
' Borrowed from Dassault macro
Public Sub MatrixProduct(ByVal matrix1, ByVal matrix2, ByRef res)

  Dim a(11)
  Dim b(11)
  Dim i As Integer
  For i = 0 To 11
    a(i) = matrix1(i)
    b(i) = matrix2(i)
  Next
 
  res(0) = a(0) * b(0) + a(1) * b(3) + a(2) * b(6)
  res(3) = a(3) * b(0) + a(4) * b(3) + a(5) * b(6)
  res(6) = a(6) * b(0) + a(7) * b(3) + a(8) * b(6)
  res(1) = a(0) * b(1) + a(1) * b(4) + a(2) * b(7)
  res(4) = a(3) * b(1) + a(4) * b(4) + a(5) * b(7)
  res(7) = a(6) * b(1) + a(7) * b(4) + a(8) * b(7)
  res(2) = a(0) * b(2) + a(1) * b(5) + a(2) * b(8)
  res(5) = a(3) * b(2) + a(4) * b(5) + a(5) * b(8)
  res(8) = a(6) * b(2) + a(7) * b(5) + a(8) * b(8)
  res(9) = a(9) * b(0) + a(10) * b(3) + a(11) * b(6) + b(9)
  res(10) = a(9) * b(1) + a(10) * b(4) + a(11) * b(7) + b(10)
  res(11) = a(9) * b(2) + a(10) * b(5) + a(11) * b(8) + b(11)

End Sub


[Diese Nachricht wurde von joehz am 12. Mrz. 2015 editiert.]

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

Sylas
Mitglied



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

Beiträge: 322
Registriert: 19.11.2012

Dell Precision T3500
Intel Xeon W3550 @ 3,07 GHz
12 GB RAM
CATIA V5 R28

erstellt am: 17. Apr. 2018 11:29    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 joehz 10 Unities + Antwort hilfreich

Hallo Joe

Ich habe deine Makro versuchen, und kriege ich solche Ergibnis:

auf der Linkeseite nach v 2, auf der Rechteseite nach v3 (mittich Original Produkt).
Kannst du mir weiterhelfen?

Gruß
Lucas

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

razzor88
Mitglied



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

Beiträge: 42
Registriert: 09.06.2016

erstellt am: 17. Apr. 2018 21: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 joehz 10 Unities + Antwort hilfreich


RGProduct.zip

 
Hallo Zusammen,

ich hab die Tage mal ein ähnliches Programm geschrieben, das allerdings kein AllCATPart erstellt, sondern ein RGProduct.
D.h. Das vorliegende Product kann 1 zu 1 in ein "totes Product umgewandelt werden" ähnlich wie beim AllCATpart, nur das die Struktur erhalten bleibt.
Erst lädt das Programm die Productstruktur in einen TreeView. Den TreeView kann man nach belieben auf / zuklappen ... Die im TreeView sichtbare Struktur wird 1 zu 1 übernommen. D.h. aus nicht aufgeklappten Unterproducten wird ein Part gemacht ...
Klickt man auf "Alles Aufklappen" und erstellt das das RGProduct, erhält man quasi die originale Struktur...
Ich hoff es ist einigermaßen verständlich? 

Es werden allerdings nur Körper kopiert!
Ich finde das Programm recht hilfreich um tote Daten zu verschicken...
Da ich es selber nicht so prickelnd finde wenn ich mal mit AllCATParts arbeiten muss, möchte ich das natürlich anderen auch nicht unbedingt zumuten   

Viel Spaß beim ausprobieren.

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

Sylas
Mitglied



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

Beiträge: 322
Registriert: 19.11.2012

Dell Precision T3500
Intel Xeon W3550 @ 3,07 GHz
12 GB RAM
CATIA V5 R28

erstellt am: 19. Apr. 2018 06: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 joehz 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von razzor88:
Hallo Zusammen,

ich hab die Tage mal ein ähnliches Programm geschrieben, das allerdings kein AllCATPart erstellt, sondern ein RGProduct.
D.h. Das vorliegende Product kann 1 zu 1 in ein "totes Product umgewandelt werden" ähnlich wie beim AllCATpart, nur das die Struktur erhalten bleibt.
Erst lädt das Programm die Productstruktur in einen TreeView. Den TreeView kann man nach belieben auf / zuklappen ... Die im TreeView sichtbare Struktur wird 1 zu 1 übernommen. D.h. aus nicht aufgeklappten Unterproducten wird ein Part gemacht ...
Klickt man auf "Alles Aufklappen" und erstellt das das RGProduct, erhält man quasi die originale Struktur...
Ich hoff es ist einigermaßen verständlich?  

Es werden allerdings nur Körper kopiert!
Ich finde das Programm recht hilfreich um tote Daten zu verschicken...
Da ich es selber nicht so prickelnd finde wenn ich mal mit AllCATParts arbeiten muss, möchte ich das natürlich anderen auch nicht unbedingt zumuten    

Viel Spaß beim ausprobieren.


Hallo

Das Programm lauft wirklich gut (fast perfekt  ).Nach dem Test kriege ich solche Ergibnis(links Quelle, rechts - Ergebnis):

Es fehlt mir Zwischenplatten. Ich verstehe dass nicht - ich habe andere Parts, welche mit Boolische operationen sind, und sie sind da...

Trotztdem brauche ich allcatpart (das wird nur ein Ausschnitt vom Code sein) , weil ich muss spater par allcatparts zusammenfasen im neuem Product.

Kannst du mir mit das helfen?

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: 19. Apr. 2018 08:40    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 joehz 10 Unities + Antwort hilfreich

Servus

Und was ist an den Teilen die nicht kopiert werden anders?
Schon mal versucht nachzuvollziehen warum das Makro von Joe nicht klappt (schrittweise ausführen und nachvollziehen)?
Wenn du noch R19 verwendest: warum dann nicht noch direkt "DECProductToPart" verwenden (AFAIR geht es da noch ohne die DF1)

Gruß
Bernd

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

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

razzor88
Mitglied



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

Beiträge: 42
Registriert: 09.06.2016

erstellt am: 19. Apr. 2018 09:09    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 joehz 10 Unities + Antwort hilfreich

Guten Morgen,

Ich hatte vergessen zu erwähnen,daß bei meinem Programm nur Sachen die im Show stehen. D.H. Alle ausgeblendeten Products oder Parts werden nicht kopiert.  Genauso wie Ausgeblendete Körper.

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

tomtom1972
Mitglied
dipl ing maschinenbau


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

Beiträge: 605
Registriert: 22.03.2005

NVidia Quadro K4000
Intel Xeon E5-1620, 64GB RAM
Windows10 64bit
R30 <= CATIA V5 > =R19

erstellt am: 19. Apr. 2018 09:43    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 joehz 10 Unities + Antwort hilfreich

Moin,
einfach Struktur als .stp exportieren und wieder in CATIA einlesen.
Funktioniert mit Script und manuell.
Alle Geometrie ist tot, alles ist vorhanden (GSD, Bodies ...)
Ebenso die Struktur.
Einfacher (und vor allem schneller) geht's nicht.
Gruß tomtom 

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

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

Sylas
Mitglied



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

Beiträge: 322
Registriert: 19.11.2012

Dell Precision T3500
Intel Xeon W3550 @ 3,07 GHz
12 GB RAM
CATIA V5 R28

erstellt am: 19. Apr. 2018 09:48    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 joehz 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von razzor88:
Guten Morgen,

Ich hatte vergessen zu erwähnen,daß bei meinem Programm nur Sachen die im Show stehen. D.H. Alle ausgeblendeten Products oder Parts werden nicht kopiert.  Genauso wie Ausgeblendete Körper.


Kein Part (Body) ist im NoShow. Andere Idee?

Zitat:
Original erstellt von bgrittmann:
Servus

Und was ist an den Teilen die nicht kopiert werden anders?
Schon mal versucht nachzuvollziehen warum das Makro von Joe nicht klappt (schrittweise ausführen und nachvollziehen)?
Wenn du noch R19 verwendest: warum dann nicht noch direkt "DECProductToPart" verwenden (AFAIR geht es da noch ohne die DF1)

Gruß
Bernd


Was fremd ist die fehlende Teile eigentlich das gleich aufgebaut sind...
Das makro von Joe ist sehr zu kompliziert,auch wegen debugging,für mich  ... Vielleicht Mann muss CATIA-optionen zuerst irgendwie stellen? Z.B. Geometrical Set mit Neuem Part setzen? Die Makro lauft bei dir ohne Probleme?
Ich arbeite schon mit R26, zeitweise mit R24 

Gruß
Lucas

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

razzor88
Mitglied



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

Beiträge: 42
Registriert: 09.06.2016

erstellt am: 22. Apr. 2018 14:36    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 joehz 10 Unities + Antwort hilfreich

Hmmmm,

seltsam bei mir scheint es bisher immer problemlos zu laufen. Konnte bisher noch keine Fehler feststellen.
Ansonsten müsstest du vielleicht mal die Daten zur Verfügung stellen bei denen Fehler auftreten, sofern das möglich ist. Dann würde mich mal gucken ob ich den Fehler finde.

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

Sylas
Mitglied



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

Beiträge: 322
Registriert: 19.11.2012

Dell Precision T3500
Intel Xeon W3550 @ 3,07 GHz
12 GB RAM
CATIA V5 R28

erstellt am: 23. Apr. 2018 07:18    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 joehz 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von razzor88:
Hmmmm,

seltsam bei mir scheint es bisher immer problemlos zu laufen. Konnte bisher noch keine Fehler feststellen.
Ansonsten müsstest du vielleicht mal die Daten zur Verfügung stellen bei denen Fehler auftreten, sofern das möglich ist. Dann würde mich mal gucken ob ich den Fehler finde.


Es tut mir leid, aber Ich kann nicht mit diese Datei verteilen mit :(

Zitat:
Original erstellt von tomtom1972:
Moin,
einfach Struktur als .stp exportieren und wieder in CATIA einlesen.
Funktioniert mit Script und manuell.
Alle Geometrie ist tot, alles ist vorhanden (GSD, Bodies ...)
Ebenso die Struktur.
Einfacher (und vor allem schneller) geht's nicht.
Gruß tomtom
------------------
tomtom1972

Ich denke ich will mit tomtom1972 Idee weiter gehen

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

Sylas
Mitglied



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

Beiträge: 322
Registriert: 19.11.2012

Dell Precision T3500
Intel Xeon W3550 @ 3,07 GHz
12 GB RAM
CATIA V5 R28

erstellt am: 24. Apr. 2018 06:15    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 joehz 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von tomtom1972:
Moin,
einfach Struktur als .stp exportieren und wieder in CATIA einlesen.
Funktioniert mit Script und manuell.
Alle Geometrie ist tot, alles ist vorhanden (GSD, Bodies ...)
Ebenso die Struktur.
Einfacher (und vor allem schneller) geht's nicht.
Gruß tomtom 


Halo tomtom1972
Ich muss meine Produkte als einzelne CATParts haben - wenn ich exportiere CATProducts als stp-File und danach öffne ich das wieder - ich kriege Productstruktur wieder - wie kann ich das überspringen?

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

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3418
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 24. Apr. 2018 08:59    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 joehz 10 Unities + Antwort hilfreich

Hallo Sylas,

öffne die STP-Datei und speichere das Produkt als Catiasfiles wieder.

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

Auch Catia ist nur ein Mensch!    

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

Sylas
Mitglied



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

Beiträge: 322
Registriert: 19.11.2012

Dell Precision T3500
Intel Xeon W3550 @ 3,07 GHz
12 GB RAM
CATIA V5 R28

erstellt am: 25. Apr. 2018 10: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 joehz 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von moppesle:
Hallo Sylas,

öffne die STP-Datei und speichere das Produkt als Catiasfiles wieder. 


So einfach? Ich will kein neues CATProduct haben, nur ein neues Part für jedes Product (anlisch wie mit CATIA Funktion: "Generate CATPart from CATProduct"). Bist du sicher?

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

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3418
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 25. Apr. 2018 11:19    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 joehz 10 Unities + Antwort hilfreich

Hallo Sylas,

ich bin mir nicht sicher was du überhaupt möchtest.

-Wenn du ein Part von deinem Produkt haben möchtest nutze "Generate Part From Produkt"

-Wenn du die Parts mit der Produktstruktur haben möchtest ist die STP-Variante die richtige.

-Wenn du die Parts einzeln ohne Produktstruktur benötigst ist auch die STP-Variante und lösche die Produkte von dem Verzeichnis.


Zitat:
Ich will kein neues CATProduct haben, nur ein neues Part für jedes Product (anlisch wie mit CATIA Funktion: "Generate CATPart from CATProduct")

-Wenn du für jedes Produkt in deiner Produktstruktur ein PArt haben möchtest musst du halt die Funktion "Generate CATPart from CATProduct" für jedes Produkt ausführen.

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

Auch Catia ist nur ein Mensch!    

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