CATIA VBA - 获取绘图中正视图的比例

Question

谁能帮我解决这个问题 - 我正在创建一个程序来自动填充绘图中的标题栏。无法获取前视图比例尺的十进制值，我也无法获取给定部分+重量的已用material。我还有下面的源代码。谢谢大家的回答！

    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("Zrkadlový", (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:D sro\Zákazky22\"

End Sub

Answer 1

每个视图都有一个比例属性:

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

CATIA VBA - 获取绘图中正视图的比例

CATIA VBA - Get scale ratio of front view in drawing

vba

scale

catia