我来帮你搞定这两个CATIA VBA开发里的问题，针对你提到的视图比例小数获取、零件材料及重量获取，下面是具体的解决方案：

问题1：无法获取主视图比例的小数数值 #

问题根源 #

你现在用realParam4.ValueAsString拿到的是比例的文本形式（比如"1:2"），不是小数数值；而且硬编码参数路径"Sheet.1\ViewMakeUp.3\Scale"很容易因为视图数量、名称变化失效，不够灵活。

解决方案 #

直接用CATIA原生属性DrwView.GenerativeBehavior.ViewScale获取小数比例，这个属性会直接返回比如0.5（对应1:2）这样的数值，既可靠又精准。如果需要显示成"1:n"的格式，基于这个数值转换就行。

修改后的相关代码片段：

' 在UserForm_Initialize和CommandButton1_Click中替换原有的Scale获取逻辑
Dim viewScale As Double
viewScale = DrwView.GenerativeBehavior.ViewScale ' 直接拿到小数比例，比如0.5代表1:2

' 转换成"1:n"格式的文本（如果需要）
Dim scaleText As String
If viewScale <> 0 Then
    scaleText = "1:" & CStr(Int(1 / viewScale))
Else
    scaleText = "1:1" ' 兜底默认比例
End If

' 在CommandButton1_Click中添加比例文本时使用
Set Mierka = DrwTexts.Add(scaleText, (238 - realXdir.ValueAsString), (40 - realYdir.ValueAsString))
' 如果要直接显示小数，就用CStr(viewScale)替代scaleText

问题2：无法获取对应零件的材料信息及重量 #

问题根源 #

你通过oProduct = DrwView.GenerativeBehavior.Document拿到的是Product文档，但零件的材料、重量信息存在Part文档的属性/参数里，得先判断文档类型，再定位到Part对象去获取。

解决方案 #

1. 材料信息：优先从Part的Material属性获取，也可以读取自定义参数（如果你的零件是用参数存储材料的）；
2. 重量信息：直接用Part的Mass属性获取，默认单位是千克，可根据CATIA设置调整。

修改后的相关代码片段：

' 在UserForm_Initialize中添加材料和重量获取逻辑
Dim oDoc As Document
Set oDoc = DrwView.GenerativeBehavior.Document
Dim oPart As Part
Dim materialName As String
Dim partMass As Double

' 区分生成视图的是Part还是Product文档
If TypeName(oDoc) = "Product" Then
    ' 如果是装配体，这里取第一个零件实例（按需调整逻辑）
    Dim oProductItem As Product
    Set oProductItem = oDoc.Products.Item(1)
    Set oPart = oProductItem.ReferenceProduct.Parent
ElseIf TypeName(oDoc) = "Part" Then
    Set oPart = oDoc
End If

' 获取材料名称
If Not oPart Is Nothing Then
    ' 方式1：从Part的Material属性读取
    If Not oPart.Material Is Nothing Then
        materialName = oPart.Material.Name
    End If
    
    ' 方式2：如果是自定义参数存储材料（比如参数名是"Material"）
    ' On Error Resume Next ' 防止参数不存在报错
    ' materialName = oPart.Parameters.Item("Material").ValueAsString
    ' On Error GoTo 0
    
    ' 获取重量，保留3位小数并加单位
    partMass = oPart.Mass
    Dim massText As String
    massText = CStr(Round(partMass, 3)) & " kg"
End If

' 将材料填入下拉框
cbMaterial.Text = materialName
' 可以加个文本框显示重量，比如tbWeight.Text = massText

优化后的关键代码片段 #

UserForm_Initialize完整优化版 #

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 oDoc As Document
 Set oDoc = DrwView.GenerativeBehavior.Document
 Dim oPart As Part
 Dim materialName As String
 Dim partMass As Double

 ' 获取关联的零件文档
 If TypeName(oDoc) = "Product" Then
     Dim oProductItem As Product
     Set oProductItem = oDoc.Products.Item(1)
     Set oPart = oProductItem.ReferenceProduct.Parent
 ElseIf TypeName(oDoc) = "Part" Then
     Set oPart = oDoc
 End If

 ' 获取视图比例
 Dim viewScale As Double
 viewScale = DrwView.GenerativeBehavior.ViewScale
 Dim scaleText As String
 If viewScale <> 0 Then
     scaleText = "1:" & CStr(Int(1 / viewScale))
 Else
     scaleText = "1:1"
 End If

 Dim datum As Date
 datum = Now()
 tbDatum.Text = Format(datum, "dd.mm.yyyy")
 cbMaterial.AddItem "S355J2G3"
 cbMaterial.AddItem "X5CrNi18-10"
 cbMaterial.AddItem "PE1000-green"
 ' 填充材料信息
 If Not oPart Is Nothing Then
     If Not oPart.Material Is Nothing Then
         materialName = oPart.Material.Name
         ' 自动添加新材料到下拉框
         On Error Resume Next
         cbMaterial.AddItem materialName
         On Error GoTo 0
         cbMaterial.Text = materialName
     End If
     ' 可选：显示重量
     ' tbWeight.Text = CStr(Round(oPart.Mass, 3)) & " kg"
 End If

 tbMierka.Text = scaleText
 ' 填充零件编号和名称
 If TypeName(oDoc) = "Product" Then
     tbCisloDielu = oDoc.PartNumber
     tbNazovDielu = oDoc.Nomenclature
 ElseIf TypeName(oDoc) = "Part" Then
     tbCisloDielu = oDoc.PartNumber
     tbNazovDielu = oDoc.Nomenclature
 End If

 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

CommandButton1_Click中比例部分优化 #

' 替换原有的Mierka添加代码
Dim viewScale As Double
viewScale = DrwView.GenerativeBehavior.ViewScale
Dim scaleText As String
If viewScale <> 0 Then
    scaleText = "1:" & CStr(Int(1 / viewScale))
Else
    scaleText = "1:1"
End If
Set Mierka = DrwTexts.Add(scaleText, (238 - realXdir.ValueAsString), (40 - realYdir.ValueAsString))
Mierka.AnchorPosition = catMiddleLeft
Mierka.SetFontName 0, 0, "Monospac821 BT"
Mierka.SetFontSize 0, 0, 3

额外小提示 #

• 建议给参数/属性读取逻辑加错误处理（On Error Resume Next/On Error GoTo 0），避免因参数不存在导致程序崩溃；
• 如果是装配体工程图，需要遍历Product里的零件来获取每个零件的信息，按需调整逻辑；
• 视图的X/Y参数也可以通过DrwView.Parameters.Item("X").Value动态获取，不用硬编码路径，适配性更强。

内容的提问来源于stack exchange，提问作者Matis_RnK