Seznam příspěvků uživatele

Set WshShell = CreateObject("WScript.Shell")

WshShell.SendKeys "{ENTER}"

hole1.CreateUserStandardDesignTable "Metric_Thin_Pitch", "c:\Program Files\Dassault Systemes\B30\win_b64\resources\standard\thread\Metric_Thin_Pitch.xml"

Sub CATMain()

   Dim oDocument As Document

   Dim oProduct As CATBaseDispatch 

   Dim oReference As Reference

   Dim oPublications As Publications

   Dim oPublication As Publication

   Dim SrEfName As String



   Set oDocument = CATIA.ActiveDocument

   Set oProduct = oDocument.Product



   sRefName = oProduct.PartNumber & "/!PartBody" 

   Set oReference = oProduct.CreateReferenceFromName(sRefName)



   Set oPublications = oProduct.Publications

   Set oPublication = oPublications.Add("Publikace")



   oPublications.SetDirect "Publikace", oReference

End Sub

Set oSel =  CATIA.ActiveDocument.Selection

Dim aObjType(0)

aObjType(0) = "DrawingView"

oSel.SelectElement2 aObjType, "Vyberte pohled...", false

Set drawingView1 = oSel.Item(1).Value

DllImport("Oleacc.dll")> _

Private Shared Function AccessibleObjectFromWindow(ByVal hwnd As Int32, ByVal dwObjectID As UInt32, ByVal riid As Byte(), <MarshalAs(UnmanagedType.IDispatch)> ByRef ppvObject As Object) As Int32

End Function



Private Sub COMFromWindow(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim CATIAWindow As Object

        Dim CATIAProcess As Process = Process.GetProcessesByName("cnext").FirstOrDefault()

        Dim hWnd As Int32 = CATIAProcess.MainWindowHandle

        Const OBJID_NATIVEOM As Int32 = 0

        Dim IID_IDispatch As Guid = New Guid("618736E0-3C3D-11CF-810C-00AA00389B71")

        ' Dim IID_IDispatch As Guid = New Guid("7FBD9AB0-6840-0000-0280-030BA6000000") '

        Dim Result As Int32 = AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, IID_IDispatch.ToByteArray, CATIAWindow)



        CATIA = CATIAWindow.Application

    End Sub

Selection.Search(".Parameter.Name='Bohrung atd',all")

For i = i To Selection.Count

   Set oParameter = Selection.Item(i).Value

   TotalLength = TotalLength + oParameter.ValueAsString ' - zde se ještě musí odseknout jednotky mm

Next 

Dim oParameter

Dim oParameters



oParameters = oDoc.Product.UserProperties

oParameter = Parameters.Item("nazev parametru")

x = CDbl(input.ToString.Replace(",","."))

Dim oCoord2(1)

Dim oPoint2D As Point2D = oSel.Item(1).Value

oPoint2D.GetCoordinates(oCoord2)

' nazev materialu

MaterialName = oPart.Parameters.GetItem("Material").ValueAsString

Sub CATMain()

   Set oSel = CATIA.ActiveDocument.Selection

   oSel.Clear()

   ' kontrola prostredi ASD - kdyz neni, spustime ho

   If (CATIA.GetWorkbenchID() <> "Assembly") Then

      oSel.Add(CATIA.ActiveDocument.Product)

      CATIA.StartWorkbench("Assembly")

   End If

   ' filtr pro kopirovane objekty - nastavime na vse

   Dim ObjSel(0)

   ObjSel(0) = "AnyObject"

   ' vyber kopirovaneho

   Status = oSel.SelectElement2(ObjSel, "Vyberte kopirovane ... ", false)

   If (Status = "Cancel") Then

      Exit sub

   End If

   oSel.Copy()

   ' vyber cile

    Status = oSel.SelectElement2(ObjSel, "Vyberte cil ... ", false)   

   If (Status = "Cancel") Then

      Exit sub

   End If

   ' a konecne vlozeni

   oSel.PasteSpecial("CATPrtResultWithOutLink")

   oSel.Clear()



   CATIA.ActiveDocument.Product.ReferenceProduct.Update()

End Sub

oDoc = CATIA.ActiveDocument

oSelection = oDoc.Selection



ReDim ObjSel(0)

ObjSel(0) = "Hole"



oSelection.SelectElement2(ObjSel, "dira", False)

oHole = oSelection.Item(1).Value



oSelection.Clear()



Dim oLimit As HybridShape

ObjSel(0) = "BiDimInfinite"



oSelection.SelectElement2(ObjSel, "face", False)

oLimit = oSelection.Item(1).Value



oHole.BottomLimit.LimitMode = CatLimitMode.catUpToSurfaceLimit

oHole.BottomLimit.LimitingElement = oLimit



oDoc.Part.Update()

Try 

  - pokusí se vykonat kód, kde očekávám chybu

Catch 

  - vykoná se, pokud chyba nastane

Finally

- vykoná se pokaždé

End Try 

' rekurzivne prochazi sestavu a odebira produkty bez reference

Private Sub RemoveMissingProducts(ByVal oProduct As Product)

    Dim oSubProducts As Products

    Dim oSubProduct As Product

    Dim RefValid As Boolean



    ' nacteme vsechny instance v sestave

    oSubProducts = oProduct.Products



    For Each oSubProduct In oSubProducts

        RefValid = True

        ' overime existenci reference

        Try 

            If oSubProduct.ReferenceProduct.Parent Is Nothing Then 

                RefValid = False

            End If 

        Catch 

            RefValid = False

        End Try 



        ' zkusime odebrat instanci

        If RefValid = False Then 

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

                ' odebereme instanci

                oProduct.Products.Remove(oSubProduct.Name)

            Catch ex As Exception

            End Try 



        Else 

            ' rekurze

            If oSubProduct.Products.Count > 0 Then

                RemoveMissingProducts(oSubProduct)

            End If 

        End If 

    Next 

End Sub