Search code examples
vbadrawingfillcatia

How to get CATPart number and name into text editor in drawing using macro?


I'm trying to create a macro in CATIA. The macro should use a UserForm with the button. After clicking on the button, it will automatically fill in the text field with data (Part Name + Part Number).

I am a total novice in VBA.

Private Sub CommandButton1_Click()
    
    Dim DrwDocument As DrawingDocument
    Set DrwDocument = CATIA.ActiveDocument

    Set DrwSheets = DrwDocument.Sheets
    Set Selection = DrwDocument.Selection
    Set DrwSheet = DrwSheets.ActiveSheet
    Set DrwView = DrwSheet.Views.ActiveView
    Set DrwTexts = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.ActiveView.Texts

    Dim parameters4 As Parameters
    Set parameters4 = DrwDocument.Parameters

    Dim realParam4 As Parameter
    Set realParam4 = parameters4.Item("Sheet.1\ViewMakeUp.3\Scale")
    
    DrwView.Activate
    Set Projekt = DrwTexts.Add(tbProjekt.Text, (288), (45.5))
    Projekt.AnchorPosition = catMiddleLeft
    Projekt.SetFontName 0, 0, "Monospac821 BT"
    Projekt.SetFontSize 0, 0, 3
        
    Set PocetKs = DrwTexts.Add(tbPocetKs.Text + "x", (36), (78))
    PocetKs.AnchorPosition = catMiddleLeft
    PocetKs.SetFontName 0, 0, "Monospac821 BT"
    PocetKs.SetFontSize 0, 0, 3
        
    If OptionZrk = True Then
        Set PocetKsZrk = DrwTexts.Add(tbPocetKs.Text + "x", (36),(70))
        PocetKsZrk.AnchorPosition = catMiddleLeft
        PocetKsZrk.SetFontName 0, 0, "Monospac821 BT"
        PocetKsZrk.SetFontSize 0, 0, 3
                
        Set ZrkText = DrwTexts.Add("Zrkadlový", (102), (80))
        ZrkText.AnchorPosition = catMiddleLeft
        ZrkText.SetFontName 0, 0, "Monospac821 BT"
        ZrkText.SetFontSize 0, 0, 3
    End If
     
    Set Material = DrwTexts.Add(cbMaterial.Text, (288), (37.5))
    Material.AnchorPosition = catMiddleLeft
    Material.SetFontName 0, 0, "Monospac821 BT"
    Material.SetFontSize 0, 0, 3
        
    Set Mierka = DrwTexts.Add(realParam4.ValueAsString, (238), (40))
    Mierka.AnchorPosition = catMiddleLeft
    Mierka.SetFontName 0, 0, "Monospac821 BT"
    Mierka.SetFontSize 0, 0, 3
        
    Set DatumUpravy = DrwTexts.Add(tbDatum.Text, (355), (38))
    DatumUpravy.AnchorPosition = catMiddleLeft
    DatumUpravy.SetFontName 0, 0, "Monospac821 BT"
    DatumUpravy.SetFontSize 0, 0, 3
    
End Sub

Solution

  • Via the GenerativeBehavior of a view you get the shown product.

    dim oProduct as Product
    Set oProduct = DrwView.GenerativeBehavior.Document
    
    MsgBox CStr(oProduct.PartNumber)
    MsgBox CStr(oProduct.Nomenclature)
    

    Make shure that the view has a link to a geometry/product