Чертежи в CATIA: Скрипт для создания рамок

[Putnik]

Здравствуйте, коллеги!
Успешно скачал "Рамка ГОСТ 2.104-68 с зонами" от 16.12.2009 от ShaytanTruba, - спасибо.
Вопрос: как из свойств детали (из part) прописать ссылку на рамку в поле "Наименование".
Линия 560 - TittleBlock_Text_Title
Дополнительно: В поле дублирования наименования изделия (в верхнем левом углу) надпись не перевернута, хотя на линии 667 имеется кодировка: - Text.Angle = 180. В свойствах поля на закладке "текст" установить: "ориентация" - горизонтальная; "зеркальное отражение" - отражение в двух направлениях, в этом случае текст настраивается правильно. Как прописать эти установки?

[xkisss]

Коллеги, добрый день. Задам простой вопрос. Есть скрипт для создания рамки для CATIA. Когда перехожу непосредственно к созданию рамки в Катьке, мне виден всего один стиль рамки. Остальные он просто не видит (см скрин). Вопрос: как сделать доступным всем скрипты, что лежат в папке VBScript\FrameTitleBlock?

[zerganalizer]

Не работает полноценно ни один из вариантов на CATIA v5r20 x64. Варианты с exe-файлами не запускаются, макросы все, кроме рамок с зонами, неправильно создают рамки страниц 2+ (тупо делают как на первой), а рамка с зонами - все линии одной толщины, не по ГОСТ. Что, нет рабочих решений до сих пор??? Позор...

[[PTM]]

все делают под себя...

[djtim]

Измененный скрипт.

выдает ошибку.
V5-6R2020

[djtim]

Выложу нашу рамку... Вроде как работает норм, если что то не так пишите... Сделана вроде по ГОСТу... короче проверяйте сами

Работает норм, то что нужно как раз. Жаль нет кнопки Update и Resize.

Материал тянет из PartBody

[[PTM]]

это должны быть отдельные функции в скрипте

[djtim]

Выложу нашу рамку... Вроде как работает норм, если что то не так пишите... Сделана вроде по ГОСТу... короче проверяйте сами

1. Нашел косячок - если в чертеже более одного листа то скрипт вносит PartNumber только на первый лист.
Интересно, легко ли это поправить?

2. Легко ли сделать возможность апдейта в рамке полей с номером детали(PartNumber) и названием (Nomenclature)?

[djtim]

Выложу нашу рамку... Вроде как работает норм, если что то не так пишите... Сделана вроде по ГОСТу... короче проверяйте сами

Доброго дня.

Никак не соображу что надо поправить, чтобы скрипт заполнял поле материала не из PartBody\Material, а из пользоват. параметра в CatPart. Помогите плз.

[djtim]

Часть кода с материалом

Код: Выделить всё

ub CATFormatRBText(textName As String, anchorPosition As String)
  '-------------------------------------------------------------------------------
  'How to format the texts belonging to the titleblock
  '-------------------------------------------------------------------------------
  Text.Name           = textName
  Text.AnchorPosition = anchorPosition
  Text.SetFontSize      0, 0, 5.

End Sub

Sub CATLinks()

Dim Material_1  As String

  '-------------------------------------------------------------------------------
  'How to fill in texts with data of the part/product linked with current sheet
  '-------------------------------------------------------------------------------
  On Error Resume Next
    Dim ProductDrawn As ProductDocument
    Set ProductDrawn = DrwSheet.Views.Item("Front view").GenerativeBehavior.Document
   err.clear
   Set ProductDrawn = DrwSheet.Views.Item("Вид спереди").GenerativeBehavior.Document
   err.clear
   If Err.Number = 0 Then
    DrwTexts.GetItem("TitleBlock_Text_Number_1").Text = ProductDrawn.PartNumber
    DrwTexts.GetItem("TitleBlock_Text_Number_2").Text = ProductDrawn.PartNumber
    DrwTexts.GetItem("TitleBlock_Text_Title").Text  = ProductDrawn.Nomenclature

    'DrwTexts.GetItem("TitleBlock_Text_Designer_1").Text = ProductDrawn.Revision
    'DrwTexts.GetItem("TitleBlock_Text_DDate_1").Text  = ProductDrawn.Definition
 

    Dim ProductAnalysis As Analyze
    Set ProductAnalysis = ProductDrawn.Analyze
    DrwTexts.GetItem("TitleBlock_Text_Weight_1").Text = FormatNumber(ProductAnalysis.Mass,3)

      
   
    Material_1 = ProductDrawn.Name&"\Material"
   err.clear
   Material_1 = ProductDrawn.Name&"\Материал"
   err.clear

    Set Mat_1 = ProductDrawn.Parameters.Item(Material_1)
    MM1 = Mat_1.ValueAsString
    DrwTexts.GetItem("TitleBlock_Text_Material").Text = Mat_1.ValueAsString

    DrwTexts.GetItem("Text_End_Area").Text  =  intParam1.ValueAsString

  End If

  '-------------------------------------------------------------------------------
  '    If No Material
  '-------------------------------------------------------------------------------
    'MsgBox "MM1иииии="+(MM1)
   'MsgBox ProductDrawn.Name&"\Материал" +"      nnnnnnnnnnnnnnnnnnnnnnnnnnnnn"
   'MsgBox ProductDrawn.Parameters.count
   'for i=1 to ProductDrawn.Parameters.count
   '   MsgBox ProductDrawn.Parameters.item(i).name +"     "+ProductDrawn.Parameters.item(i).ValueAsString
   'next
     If  (MM1 <> "")  Then 
     Else 
         Material_1 = ProductDrawn.Name&"\PartBody\Material"
         Set Mat_1 = ProductDrawn.Parameters.Item(Material_1)

         MM1 = Mat_1.ValueAsString
         DrwTexts.GetItem("TitleBlock_Text_Material").Text = Mat_1.ValueAsString
     End If

     If  (MM1 <> "None")  Then 
     Else 
         Material_1 = ProductDrawn.Name&"\PartBody\Material"
         Set Mat_1 = ProductDrawn.Parameters.Item(Material_1)
         MM1 = Mat_1.ValueAsString
         DrwTexts.GetItem("TitleBlock_Text_Material").Text = Mat_1.ValueAsString
     End If


  '-------------------------------------------------------------------------------
  'InputBoxNameMaterial
  '-------------------------------------------------------------------------------
   Dim NewText As DrawingTexts
   Dim Variable As String



     If  (MM1 <> "")  Then 
     Else 

       Set NewText = DrwTexts.GetItem("TitleBlock_Text_Material")
       Variable = InputBox(