CATIAVBA-獲取繪圖中前視圖的比例

誰能幫我解決這個問題 - 我正在創建一個程式來自動填充繪圖中的標題欄。無法獲得前視圖比例的十進制值，我也無法獲得給定零件的使用材料 重量。我仍然有以下源代碼。謝謝大家的回答！

    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 oProduct As Product
    Set oProduct = DrwView.GenerativeBehavior.Document
  
    Dim parameters4 As Parameters
    Set parameters4 = DrwDocument.Parameters

    Dim realParam4 As Parameter
    Set realParam4 = parameters4.Item("Sheet.1\ViewMakeUp.3\Scale")
    
    Dim parametersX As Parameters
    Set parametersX = DrwDocument.Parameters
    Dim realXdir As Parameter
    Set realXdir = parametersX.Item("Sheet.1\ViewMakeUp.3\X")
    
    Dim parametersY As Parameters
    Set parametersY = DrwDocument.Parameters
    Dim realYdir As Parameter
    Set realYdir = parametersY.Item("Sheet.1\ViewMakeUp.3\Y")
 
    
    DrwView.Activate
    
        If tbProjekt = "" Then
        MsgBox ("Nevyplnené pole PROJEKT!")
        Else
        Set Projekt = DrwTexts.Add(tbProjekt.Text, (288 - realXdir.ValueAsString), (45.5 - realYdir.ValueAsString))
        Projekt.AnchorPosition = catMiddleLeft
        Projekt.SetFontName 0, 0, "Monospac821 BT"
        Projekt.SetFontSize 0, 0, 3
        End If
        
        Set PocetKs = DrwTexts.Add(tbPocetKs.Text   "x", (36 - realXdir.ValueAsString), (78 - realYdir.ValueAsString))
        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 - realXdir.ValueAsString), (68 - realYdir.ValueAsString))
                PocetKsZrk.AnchorPosition = catMiddleLeft
                PocetKsZrk.SetFontName 0, 0, "Monospac821 BT"
                PocetKsZrk.SetFontSize 0, 0, 3
                
                Set ZrkText = DrwTexts.Add("Zrkadlovy", (103 - realXdir.ValueAsString), (68 - realYdir.ValueAsString))
                ZrkText.AnchorPosition = catMiddleLeft
                ZrkText.SetFontName 0, 0, "Arial (TrueType)"
                ZrkText.SetFontSize 0, 0, 4
                
            End If
     
        Set Material = DrwTexts.Add(cbMaterial.Text, (288 - realXdir.ValueAsString), (37.5 - realYdir.ValueAsString))
        Material.AnchorPosition = catMiddleLeft
        Material.SetFontName 0, 0, "Monospac821 BT"
        Material.SetFontSize 0, 0, 3
        
        Set Mierka = DrwTexts.Add(realParam4.ValueAsString, (238 - realXdir.ValueAsString), (40 - realYdir.ValueAsString))
        Mierka.AnchorPosition = catMiddleLeft
        Mierka.SetFontName 0, 0, "Monospac821 BT"
        Mierka.SetFontSize 0, 0, 3
        
        Set DatumUpravy = DrwTexts.Add(tbDatum.Text, (355 - realXdir.ValueAsString), (38 - realYdir.ValueAsString))
        DatumUpravy.AnchorPosition = catMiddleLeft
        DatumUpravy.SetFontName 0, 0, "Monospac821 BT"
        DatumUpravy.SetFontSize 0, 0, 3
        
        Set CisloDielu = DrwTexts.Add(tbCisloDielu.Text, (314 - realXdir.ValueAsString), (14.5 - realYdir.ValueAsString))
        CisloDielu.AnchorPosition = catMiddleLeft
        CisloDielu.SetFontName 0, 0, "Monospac821 BT"
        CisloDielu.SetFontSize 0, 0, 4
        
        Set NazovDielu = DrwTexts.Add(tbNazovDielu.Text, (321 - realXdir.ValueAsString), (26 - realYdir.ValueAsString))
        NazovDielu.AnchorPosition = catMiddleLeft
        NazovDielu.SetFontName 0, 0, "Monospac821 BT"
        NazovDielu.SetFontSize 0, 0, 4
        
        Set Pozicia = DrwTexts.Add(tbPozicia.Text, (388 - realXdir.ValueAsString), (26 - realYdir.ValueAsString))
        Pozicia.AnchorPosition = catMiddleLeft
        Pozicia.SetFontName 0, 0, "Monospac821 BT"
        Pozicia.SetFontSize 0, 0, 5

        
End Property


Private Sub UserForm_Initialize()
    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 oProduct As Product
    Set oProduct = DrwView.GenerativeBehavior.Document
    
    Dim parameters4 As Parameters
    Set parameters4 = DrwDocument.Parameters

    Dim realParam4 As Parameter
    Set realParam4 = parameters4.Item("Sheet.1\ViewMakeUp.3\Scale")
    Dim datum As Date
    datum = Now()
    tbDatum.Text = Format(datum, "dd.mm.yyyy")
       
    
   cbMaterial.AddItem "S355J2G3"
   cbMaterial.AddItem "X5CrNi18-10"
   cbMaterial.AddItem "PE1000-green"
   
    tbMierka.Text = realParam4.ValueAsString
    tbCisloDielu = (oProduct.PartNumber)
    tbNazovDielu = (oProduct.Nomenclature)
    Dim cProjektu As String
    cProjektu = tbCisloDielu.value
    tbProjekt.Text = Left(cProjektu, 6)
    Dim parametersX As Parameters
    Set parametersX = DrwDocument.Parameters
    Dim realXdir As Parameter
    Set realXdir = parametersX.Item("Sheet.1\ViewMakeUp.3\X")
    
    Dim parametersY As Parameters
    Set parametersY = DrwDocument.Parameters
    Dim realYdir As Parameter
    Set realYdir = parametersY.Item("Sheet.1\ViewMakeUp.3\Y")
    tbPriecinok.Text = "D:\3D sro\Zákazky\2022\"

End Sub

uj5u.com熱心網友回復：

每個視圖都有一個比例屬性：

dScale = DrwView.Scale2

（另請參閱檔案中的 DrawingView-Object）

而不是使用活動視圖嘗試：

Set oDrwViewForground =  DrwSheet.Views.Item(1)
Set oDrwViewBackground =  DrwSheet.Views.Item(2)
Set oDrwViewFrontview =  DrwSheet.Views.Item(3) 'first user generated view

標籤：vba 规模 卡蒂亚

上一篇：通過VBA將大量圖表從Excel復制并粘貼到PowerPoint

下一篇：突出顯示不符合下拉條件的單元格