Seznam příspěvků uživatele

Sub fCreatePublic(ByRef oObject As Body, ByRef u)

    Dim oPublications As Publications

    Dim oReference As INFITF.Reference

    Dim oPart As Part

    Dim oBodyName As String

    Dim oBody As Body

    

    Set oPart = oObject.Parent.Parent

    Set oPublications = oPart.Parent.Product.Publications

    oBodyName = oObject.Name



        

    Set oReference = oPart.CreateReferenceFromObject(oPart.Bodies.Item(u))

    Set publication1 = oPublications.Add(oBodyName)

    oPublications.SetDirect oBodyName, oReference

End Sub

Sub CATMain()

Dim oDocs As Documents

Dim oDocument As Document

Dim fName As String

Set oDocs = CATIA.Documents

For i = 1 To oDocs.count

  Set oDocument = oDocs.Item(i)

   If TypeName(oDocument) = "PartDocument" Then

        fName = oDocs.Item(i).Name

        If Mid(fName, 1, 3) <> "CAT" Then oDocs.Item(fName).Open

   End If

Next

End Sub

For Each oSubProduct In oProduct.Products

  oPartName = oSubProduct.PartNumber

  If oPartName=hledanyPart then

    oSelection1.Item (1)

    CATIA.StartCommand "Open in New Window"

  End if

  If oSubProduct.Products.count > 0 Then

          Explore oSubProduct

  End If

Next

parametr1 = oSubProduct.Parameters.Item("parametr1").Value

 Dim Odocs As Documents

 Dim Odraw As DrawingDocument

 Dim oFileName As String

 Dim Filelist As String

 Dim path As String

 Dim soubor As String

 Dim List As String



 path = "C:\Pokus\"

 Filelist = Dir(path & "*.CATDrawing")



 Do While Filelist <> ""

  soubr = path & Filelist

  Set Odocs = CATIA.Documents

  Set Odraw = Odocs.Read(path & Filelist)

  oFileName = Odraw.DrawingRoot.Sheets.Item(1).Views.Item(3).GenerativeBehavior.Document.Parent.Name

  List = List & oFileName & Chr(13)

  Filelist = Dir

 Loop

 MsgBox (List)

Sub CATMain()

Dim acDoc As Document

Dim acProd As Product

Dim acProds As Products

Set acDoc = CATIA.ActiveDocument

Set acProd = acDoc.Product

acProd.ApplyWorkMode DESIGN_MODE

 RemoveMissingProducts acProd

End Sub

Private Sub RemoveMissingProducts(ByVal oProduct As Product)

    Dim oSubProducts As Products

    Dim oSubProduct As Product

    Dim RefValid As Boolean

    ' nacteme vsechny instance v sestave

Set oSubProducts = oProduct.Products

    For Each oSubProduct In oSubProducts

        RefValid = True

        ' overime existenci reference

        On Error Resume Next

            If oSubProduct.ReferenceProduct.Parent Is Nothing Then

                RefValid = False

            End If

        ' zkusime odebrat instanci

      If Err <> 0 Then

        If RefValid = False Then

      End If

On Error Resume Next

            'Try kvuli chybe v API to produkt odebere, ale shori

                ' odebereme instanci

                oProduct.Products.Remove (oSubProduct.Name)

        Else

            ' rekurze

            If oSubProduct.Products.Count > 0 Then

                RemoveMissingProducts (oSubProduct)

            End If

        End If

    Next 

    MsgBox ("All missing product have been removed")



End Sub

Sub CATMain()

Dim acDoc

Dim acProd

Set acDoc = CATIA.ActiveDocument

Set acProd = acDoc.Product

acProd.ApplyWorkMode DESIGN_MODE

RemoveMissingProducts acProd

End Sub

Private Sub RemoveMissingProducts(ByVal oProduct As Product)

    Dim oSubProducts As Products

    Dim oSubProduct As Product

    Dim RefValid As Boolean

    ' nacteme vsechny instance v sestave

Set oSubProducts = oProduct.Products

    For Each oSubProduct In oSubProducts

        RefValid = True

        ' overime existenci reference

        On Error GoTo ErrHandler1:

            If oSubProduct.ReferenceProduct.Parent Is Nothing Then

                RefValid = False

            End If

ErrHandler1:

            RefValid = False

        ' zkusime odebrat instanci

        If RefValid = False Then

On Error GoTo ErrHandler2:

            'Try kvuli chybe v API to produkt odebere, ale shori

                ' odebereme instanci

                oProduct.Products.Remove (oSubProduct.Name)

ErrHandler2:

        Else

            ' rekurze

            If oSubProduct.Products.Count > 0 Then

                RemoveMissingProducts (oSubProduct)

            End If

        End If

    Next

    MsgBox ("All missing products have been removing")

End Sub

 

Sub CATMain()

Dim oProduct As Product

Dim oDocument As Document



Set oDocument = CATIA.ActiveDocument

Set oProduct = oDocument.Product

oProduct.ApplyWorkMode DESIGN_MODE



WalkThroughTree oProduct



MsgBox ("HOTOVO")





End Sub

Private Sub WalkThroughTree(ByVal oSubProduct As Product)

    Dim oDoc As Document

    Dim oSubProducts As Products

    Dim RefValid As Boolean

    Dim PartName, FileName, InstanceName, cesta As String

    

    ' nacteme vsechny instance v sestave



    For Each oSubProduct In oSubProduct.Products

     FileName = oSubProduct.ReferenceProduct.Parent.Name

     PartName = oSubProduct.ReferenceProduct.PartNumber

     cesta = oSubProduct.ReferenceProduct.Parent.Path

     

      If PartName <> FileName Then

        Set oDoc = CATIA.ActiveDocument

        Set oDoc = oSubProduct

        oDoc.SaveAs (cesta & PartName)

     

       

      End If

     



    

     If oSubProduct.Products.Count > 0 Then

       WalkThroughTree oSubProduct

     End If

    Next

    



End Sub