Вітаю!
Разом з @Andrii_Humeniuk вирішили підняти наступну тему. Вірніше я хочу його в цій темі підтримати.
При виконанні креслень часто видаляють вже готові види на листах, а від того збивається нумерація видів. Також відповідно до правил ЄСКД, якщо у вида масштаб відповідає зазначеному в штампі, тоді у назві вида не потрібно показувати його масштаб. Чи можна якось допомогти оптимізувати ці рутинні проблеми?
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" повідомленню! | Do you find the posts helpful? "LIKE" these posts!
На ваше запитання відповіли? Натисніть кнопку 'ПРИЙНЯТИ РІШЕННЯ' | Have your question been answered successfully? Click 'ACCEPT SOLUTION' button.
Дмитро Мухін | Dmytro Mukhin Facebook | Instagram | InventorInUa
Solved! Go to Solution.
Solved by Andrii_Humeniuk. Go to Solution.
Вітаю @DmytroMukhin ! Мою макрос, який виконує вище вказанні перевірки:
Sub main
If TypeOf ThisDoc.Document Is DrawingDocument Then
Dim oDraw As DrawingDocument = ThisDoc.Document
Dim oTM As TransactionManager = ThisApplication.TransactionManager
Dim oSheets As Sheets = oDraw.Sheets
If oSheets.Item(1).DrawingViews.Count = 0 Then
Exit Sub
End If
Dim oSheet As Sheet
Dim oViews As DrawingViews
Dim oView As DrawingView
Dim ViewLetter = New String() {"A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "R", "S", "T", "U", "V", "W", "X", "Y"}
' Dim ViewLetter = New String() {"А", "Б", "В", "Г", "Д", "Е", "Ж", "Й", "К", "Л", "М", "Н", "П", "Р", "С", "Т", "У", "Ф", "Ц", "Ш", "Щ", "Ю", "Я" }
Dim ViewCount As Integer = 0
Dim o1stViewScale As String = oSheets.Item(1).DrawingViews.Item(1).ScaleString
Dim oView_Number As String = "<StyleOverride Underline='False'><DrawingViewName/></StyleOverride>"
Dim oView_Scale As String = "<StyleOverride Underline='False'> (<DrawingViewScale/></StyleOverride>)"
Dim oView_Name As String
Dim numbList As New ArrayList
Dim newTM As Transaction = oTM.StartTransaction(oDraw, "ChangeViewsName")
For i = 1 To oSheets.Count
numbList.Add(oSheets.Item(i).Name)
Next
For Each oSheet In oSheets
oViews = oSheet.DrawingViews
For Each oView In oViews
If oView.ShowLabel Then
If Not IsNothing(oView.ParentView) Then
Dim numbLetters As Double = ViewCount / ViewLetter.Length
If o1stViewScale = oView.ScaleString Then
oView_Name = oView_Number
Else
oView_Name = oView_Number & oView_Scale
End If
If oView.ViewType = DrawingViewTypeEnum.kDetailDrawingViewType Or _
oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType Or _
oView.ViewType = DrawingViewTypeEnum.kProjectedDrawingViewType Or _
oView.ViewType = DrawingViewTypeEnum.kAuxiliaryDrawingViewType Then
If numbLetters <= 1 Then
oView.Name = ViewLetter(ViewCount)
Else If numbLetters > 1 And numbLetters <= 2 Then
oView.Name = ViewLetter(0) & ViewLetter(ViewCount - ViewLetter.Length)
Else If numbLetters > 2 And numbLetters <= 3 Then
oView.Name = ViewLetter(1) & ViewLetter(ViewCount - ViewLetter.Length*2)
End If
If oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType And oView.Label.Text.Contains("-") Then
oView.Label.FormattedText = oView_Number & "-" & oView_Name
Else
oView.Label.FormattedText = oView_Name
End If
ViewCount = ViewCount + 1
End If
Else
If o1stViewScale = oView.ScaleString Then
oView_Name = oView_Number
Else
oView_Name = oView_Number & oView_Scale
End If
oView.Label.FormattedText = oView_Name
End If
End If
Next
Next
newTM.End()
End If
End Sub
Рядок 15 - англійський алфавіт, рядок 16 - український алфавіт. У обох відсутні літери, які не рекомендується використовувати у назвах видів. В коді активний англійкий алфавіт, щоб активувати український, потрібно закоментити рядок 15 та відповідно розкоментити 16-й.
P.S. Особисто я додав дане правило в шаблон креслення до "Event Triggers", в пункт "Before Save Document". Таким чином при збереженні файлу правило виконає перевірку автоматично.
P.S.S. Сподіваюсь тема буде корисною для форумчан та надіхне на цікаві ідеї в сфері написання макросів. Дякую, @DmytroMukhin за підтримку.
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Так, дуже потрібний макрос!
Але за стандартом ДСТУ ISO 128-44:2005 вже має використовуватись латинська абетка.
Також бажано додати перевірку на поворот вида та додавання відповідної позначки.
Раніше це був символ , зараз має бути
Щоб його додавати в автоматичному режимі слід перевіряти властивість виду
.....
Dim oDocDwg As Sheet
Set oDocDwg = ThisApplication.ActiveDocument.ActiveSheet
oDocDwg.DrawingViews.Item(i).Rotation
.....
і, якщо кут відрізняється від 0, додавати відповідне позначення у вигляді:
' фрагмент кода на VBA для додавання/прибирання символу повороту виду
..................
Dim fRot As String
For i = 2 To oDocDwg.DrawingViews.Count
BasViewLabel = oDocDwg.DrawingViews.Item(i).Label.FormattedText
If Abs(oDocDwg.DrawingViews.Item(i).Rotation) < 0.01 Then
fRot = ""
Else
fRot = " " & ChrW(&HE94E)
' це код кругової стрілки, зараз треба визначити новий код та
' додати величину кута та символ "градус"
End If
If oDocDwg.DrawingViews.Item(i).Scale = oDocDwg.DrawingViews.Item(1).Scale Then
If oDocDwg.DrawingViews.Item(i).ViewType = kSectionDrawingViewType Then
oDocDwg.DrawingViews.Item(i).Label.FormattedText = "<DrawingViewName/>-<DrawingViewName/>" & fRot
Else
oDocDwg.DrawingViews.Item(i).Label.FormattedText = "<DrawingViewName/>" & fRot
End If
Else
If oDocDwg.DrawingViews.Item(i).ViewType = kSectionDrawingViewType Then
oDocDwg.DrawingViews.Item(i).Label.FormattedText = "<DrawingViewName/>-<DrawingViewName/> (<DrawingViewScale/>)" & fRot
Else
oDocDwg.DrawingViews.Item(i).Label.FormattedText = "<DrawingViewName/> (<DrawingViewScale/>)" & fRot
End If
End If
Next
Мабуть, доречно об'єднати в одно правило
Do you find the posts helpful? "LIKE" these posts! | Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням!
Have your question been answered successfully? Click "ACCEPT SOLUTION" button. | На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ"
.
Дякую за пораду. Я додав Ваш код до свого, але отримав не вірний символ . Думаю, це пов'язано з тим, що у нас різний тип тексту, я використовую "Tahoma".
Ось так виглядає підшитий код (додав між 74 та 75 рядок):
Dim dDeg As Double = Round(oView.Rotation * 180/PI, 3)
If dDeg > 0.01 Then
oView.Label.FormattedText = oView.Label.FormattedText & " " & ChrW(&HE906) & " " & dDeg & ChrW(176)
End If
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Так, ми використовуємо "GOST Common".
Символ, показаний у ДСТУ ISO 128-44:2005 має в ньому код &H21B7 (він є також у ISOCPEUR)
Do you find the posts helpful? "LIKE" these posts! | Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням!
Have your question been answered successfully? Click "ACCEPT SOLUTION" button. | На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ"
.
По стандарту ми показуємо кут повороту за годинниковою стрілкою, а в Інвенторі це від'ємний кут.
тому, мабуть:
Dim dDeg As Double = -Round(oView.Rotation * 180 / PI, 3) If dDeg > 0.01 Then oView.Label.FormattedText = oView.Label.FormattedText & " " & ChrW(&H21B7) & " " & dDeg & ChrW(176) Else If dDeg < -0.01 Then oView.Label.FormattedText = oView.Label.FormattedText & " " & ChrW(&H21B7) & " " & 360 + dDeg & ChrW(176) End If End If
Do you find the posts helpful? "LIKE" these posts! | Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням!
Have your question been answered successfully? Click "ACCEPT SOLUTION" button. | На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ"
.
Дякую за інформацію. Додав перевірку на яку із сторін буде швидче покрутити, щоб отримати потрібний вигляд (типу стрілка за годинниковою стрілкою чи проти годинникової стрілки). Для того, щоб уникнути конфлікту з існуючими стилями тексту, виділив символ стрілки в окремий стиль, який описаний в рядку 90 ,Шрифт - @Arial Unicode MS, Висота тексту - 8.
Sub main
If TypeOf ThisDoc.Document Is DrawingDocument Then
Dim oDraw As DrawingDocument = ThisDoc.Document
Dim oTM As TransactionManager = ThisApplication.TransactionManager
Dim oSheets As Sheets = oDraw.Sheets
If oSheets.Item(1).DrawingViews.Count = 0 Then
Exit Sub
End If
Dim oSheet As Sheet
Dim oViews As DrawingViews
Dim oView As DrawingView
Dim ViewLetter = New String() {"A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "R", "S", "T", "U", "V", "W", "X", "Y"}
' Dim ViewLetter = New String() {"А", "Б", "В", "Г", "Д", "Е", "Ж", "Й", "К", "Л", "М", "Н", "П", "Р", "С", "Т", "У", "Ф", "Ц", "Ш", "Щ", "Ю", "Я" }
Dim ViewCount As Integer = 0
Dim o1stViewScale As String = oSheets.Item(1).DrawingViews.Item(1).ScaleString
Dim oView_Number As String = "<StyleOverride Underline='False'><DrawingViewName/></StyleOverride>"
Dim oView_Scale As String = "<StyleOverride Underline='False'> (<DrawingViewScale/></StyleOverride>)"
Dim oView_Name As String
Dim numbList As New ArrayList
Dim newTM As Transaction = oTM.StartTransaction(oDraw, "ChangeViewsName")
For i = 1 To oSheets.Count
numbList.Add(oSheets.Item(i).Name)
Next
For Each oSheet In oSheets
oViews = oSheet.DrawingViews
For Each oView In oViews
If oView.ShowLabel Then
If Not IsNothing(oView.ParentView) Then
Dim numbLetters As Double = ViewCount / ViewLetter.Length
If o1stViewScale = oView.ScaleString Then
oView_Name = oView_Number
Else
oView_Name = oView_Number & oView_Scale
End If
If oView.ViewType = DrawingViewTypeEnum.kDetailDrawingViewType Or _
oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType Or _
oView.ViewType = DrawingViewTypeEnum.kProjectedDrawingViewType Or _
oView.ViewType = DrawingViewTypeEnum.kAuxiliaryDrawingViewType Then
If numbLetters <= 1 Then
oView.Name = ViewLetter(ViewCount)
Else If numbLetters > 1 And numbLetters <= 2 Then
oView.Name = ViewLetter(0) & ViewLetter(ViewCount - ViewLetter.Length)
Else If numbLetters > 2 And numbLetters <= 3 Then
oView.Name = ViewLetter(1) & ViewLetter(ViewCount - ViewLetter.Length*2)
End If
If oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType And oView.Label.Text.Contains("-") Then
oView.Label.FormattedText = oView_Number & "-" & oView_Name
Else
oView.Label.FormattedText = oView_Name
End If
ViewCount = ViewCount + 1
End If
Else
If o1stViewScale = oView.ScaleString Then
oView_Name = oView_Number
Else
oView_Name = oView_Number & oView_Scale
End If
oView.Label.FormattedText = oView_Name
End If
Dim dDeg As Double = Round(oView.Rotation * 180 / PI, 2)
Do While dDeg > 360.01
dDeg = dDeg - 360
Loop
If dDeg <> 0 And dDeg <> 360 Then
Dim sDeg As String
Dim sRotate As String
If Abs(dDeg) < 180.01 Then
sDeg = Abs(dDeg) & ChrW(176)
If dDeg < 0 Then
sRotate = ChrW(&H21B7)
Else
sRotate = ChrW(&H21B6)
End If
Else
sDeg = Abs(dDeg) - 180 & ChrW(176)
If dDeg < 0 Then
sRotate = ChrW(&H21B6)
Else
sRotate = ChrW(&H21B7)
End If
End If
oView.Label.FormattedText = oView.Label.FormattedText & _
" <StyleOverride Font='@Arial Unicode MS' FontSize='0,8'>" & sRotate & " </StyleOverride>" & sDeg
End If
End If
Next
Next
newTM.End()
End If
End Sub
Виглядає досить круто, ще раз дякую за підсказки.
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Доброго дня,
1. Створити текстовий, скопіювати в нього макрос та зберегти, наприклад, у
C:\Users\Public\Documents\Autodesk\Inventor 20ХХ\Macros
2. В Інвенторі зайти у налаштування iLogic та задати місце зберігання (Tools --> Option+)
3. Якщо у браузері моделі немає відповідної вкладки, додайте її
4. Перейдіть на вкладку iLogic --> External Rules
5. Маєте побачити відповідні правила
6. Перетягніть правило у відповідний розділ (затиснувши ЛКМ)
7. Правило буде спрацьовувати автоматично по заданій умові.
Більш докладно (для відповідної версії):
https://help.autodesk.com/view/INVNTOR/2023/ENU/?guid=GUID-C5ADE109-10E9-41A0-BC4A-BE73AA68A1C7
Do you find the posts helpful? "LIKE" these posts! | Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням!
Have your question been answered successfully? Click "ACCEPT SOLUTION" button. | На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ"
.
Вітаю @BleckMen08 ! Мене на кілька хвилин випередили, але я все ж бажаю викласти відео про налаштування внутрішнього правила.
Внутрішні та зовнішні правила мають свої переваги та недоліки, і доцільність їх використання залежить від природи правила.
Внутрішнє правило прив'язується виключно до одного документа, в якому знаходиться.
Перевагою є можливість індивідуального налаштування правила для конкретного документа. Наприклад, під час роботи в документі креслення ви можете використовувати український алфавіт або відображення повороту виду. В такому випадку ви просто редагуєте правило в документі, не турбуючись про цілісність шаблону.
Недоліком є неможливість розповсюдити зміни в правилі на вже існуючі документи, тому доведеться окремо змінювати правило в кожному документі.
Зовнішнє правило зберігається в окремій теці та не враховує існування документів креслення. Таким чином, переваги та недоліки порівнюваних з внутрішніми правилами змінюються.
При використанні зовнішніх правил потрібно завжди мати на увазі, що ваше правило знаходиться лише на вашому комп'ютері, і якщо ви хочете передати комусь ваші документи креслення, в яких є посилання на ці правила, вам доведеться передати й правила як окремі файли.
Особисто я правило по відслідковуваню найменування видів у креслиннику використовую, як зовнішнє, тому зверніть увагу на повідомлення @Alexander_Chernikov .
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Вітаю!
Щоб вручну не закоментовувати/розкоментовувати множину літер, можна перевіряти стандарт поточного документа (кресленика): якщо GOST - кирилиця, для інших - латиниця.
Додаю приклад
Sub Main () ' GetStd()
Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim iCode As Long = oDoc.StylesManager.ActiveStandardStyle.InternationalStandardReference
Select Case iCode
Case 9729
InputBox ("Current standard is DEFAULT")
Case 9731
InputBox ("Current standard is ANSI")
Case 9732
InputBox ("Current standard is BSI")
Case 9733
InputBox ("Current standard is DIN")
Case 9734
InputBox ("Current standard is GB")
Case 9735
InputBox ("Current standard is ISO")
Case 9736
InputBox ("Current standard is JIS")
Case 9737
InputBox ("Current standard is GOST")
Case Else
InputBox ("Current standard is UNKNOWN ")
End Select
End Sub
Do you find the posts helpful? "LIKE" these posts! | Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням!
Have your question been answered successfully? Click "ACCEPT SOLUTION" button. | На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ"
.
Вітаю!
Вважаю, що це вже більш персоналізоване налаштування. Кожен має право обирати те, що йому більше підходить без прив'язки до якихось обставин. Наприклад, я використовую шаблон "GOST" та англійські літери. В будь-якому випадку, якщо для когось це важливо, в документі нижче правило з прив'язкою до стандарту.
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Вітаю колеги!
Виявив у своєму коді грубі помилки з найменуванням видів у випадку, коли потрібно застосовувати більше ніж одну літеру (АА, АВ, АС...).
Також вніс зміни у структуру коду, тепер він більш логічніший та читабільніший.
Якщо комусь не потрібно зазначати поворот виду (знак повороту та градуси), закоментуйте рядки 75, 77-81.
Окрім цього, код додає сторінку аркуша* до імені виду, якщо вид та його бадьківський вид знаходяться на різних аркушах. Для того щоб це прибрати закоментуйте рядки 69-71.
Sub main
Dim oDraw As DrawingDocument : oDraw = ThisDoc.Document
Dim oTM As TransactionManager = ThisApplication.TransactionManager
Dim oSheets As Sheets = oDraw.Sheets
Dim oFirstView As DrawingView = GetFirstView(oSheets)
If oFirstView Is Nothing Then Exit Sub
Dim ViewLetter As String() = {"A","B","C","D","E","F","G","H","J","K","L","M","N","P","R","S","T","U","V","W","X","Y"}
Dim iViewCount As Integer = 0
Dim o1stViewScale As String = oFirstView.ScaleString
Dim oView_Number As String = "<StyleOverride Underline='False'><DrawingViewName/></StyleOverride>"
Dim oView_Scale As String = "<StyleOverride Underline='False'> (<DrawingViewScale/></StyleOverride>)"
Dim oView_Name As String
Dim numbList As New ArrayList
Dim newTM As Transaction = oTM.StartTransaction(oDraw, "ChangeViewsName")
For i As Integer = 1 To oSheets.Count
numbList.Add(oSheets(i).Name)
Next
For Each oSheet As Sheet In oSheets
For Each oView As DrawingView In oSheet.DrawingViews
If Not oView.ShowLabel Then Continue For
Dim sNameView As String = oView.Label.FormattedText
If o1stViewScale = oView.ScaleString Then
oView_Name = oView_Number
Else
oView_Name = oView_Number & oView_Scale
End If
If Not IsNothing(oView.ParentView) Then
If oView.ViewType = DrawingViewTypeEnum.kAssociativeDraftDrawingViewType Then Continue For
' If oView.ViewType = DrawingViewTypeEnum.kAuxiliaryDrawingViewType Then Continue For
If oView.ViewType = DrawingViewTypeEnum.kCustomDrawingViewType Then Continue For
If oView.ViewType = DrawingViewTypeEnum.kDefaultDrawingViewType Then Continue For
' If oView.ViewType = DrawingViewTypeEnum.kDetailDrawingViewType Then Continue For
If oView.ViewType = DrawingViewTypeEnum.kDraftDrawingViewType Then Continue For
If oView.ViewType = DrawingViewTypeEnum.kOLEAttachmentDrawingViewType Then Continue For
If oView.ViewType = DrawingViewTypeEnum.kOverlayDrawingViewType Then Continue For
' If oView.ViewType = DrawingViewTypeEnum.kProjectedDrawingViewType Then Continue For
' If oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType Then Continue For
If oView.ViewType = DrawingViewTypeEnum.kStandardDrawingViewType Then Continue For
If iViewCount < ViewLetter.Length Then
oView.Name = ViewLetter(iViewCount)
Else
Dim dMaxCount As Integer = ViewLetter.Length + ViewLetter.Length
If ViewLetter.Length <= iViewCount And iViewCount < (dMaxCount) Then
oView.Name = ViewLetter(0) & ViewLetter(iViewCount - ViewLetter.Length)
Else
Dim iStepNumb As Double = iViewCount - (dMaxCount - 1)
Dim iStep As Integer = Ceil(iStepNumb / ViewLetter.Length)
Dim iNumb As Double = iViewCount - (ViewLetter.Length * (iStep+1))
oView.Name = ViewLetter(iStep) & ViewLetter(iNumb)
End If
End If
iViewCount = iViewCount + 1
Dim sSheetName As String = oView.ParentView.Parent.Name
If oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType _
And oView.Label.Text.Contains("-") Then
sNameView = oView_Number & "-" & oView_Name
Else
sNameView = oView_Name
End If
If sSheetName <> oView.Parent.Name Then
sNameView = sNameView & " (" & numbList.IndexOf(sSheetName) + 1 & ")"
End If
Else
sNameView = oView_Name
End If
If oView.Rotation = 0 Then
oView.Label.FormattedText = sNameView
Else
sNameView = CheckRotateView(oView)
If sNameView Is Nothing Then Continue For
oView.Label.FormattedText = sNameView
End If
Next
Next
newTM.End()
End Sub
Private Function GetFirstView(ByVal oSheets As Sheets) As DrawingView
For iSheet As Integer = 1 To oSheets.Count
If oSheets(iSheet).DrawingViews.Count = 0 Then Continue For
Return oSheets(iSheet).DrawingViews(1)
Next
Return Nothing
End Function
Private Function CheckRotateView(ByVal oView As DrawingView) As String
Dim dDeg As Double = Round(oView.Rotation * 180 / PI, 2)
Do While dDeg > 360.01
dDeg = dDeg - 360
Loop
If dDeg <> 0 And dDeg <> 360 Then
Dim sDeg, sRotate As String
If Abs(dDeg) < 180.01 Then
sDeg = Abs(dDeg) & ChrW(176)
If dDeg < 0 Then : sRotate = ChrW(&H21B7)
Else : sRotate = ChrW(&H21B6)
End If
Else
sDeg = Abs(dDeg) - 180 & ChrW(176)
If dDeg < 0 Then : sRotate = ChrW(&H21B6)
Else : sRotate = ChrW(&H21B7)
End If
End If
Return oView.Label.FormattedText & " <StyleOverride Font='@Arial Unicode MS' FontSize='0,8'>" _
& sRotate & " </StyleOverride>" & sDeg
End If
Return Nothing
End Function
В коді лише англійський алфавіт, сподіваюсь, ви знаєте, що робити, якщо вам потрібен інший:)
* Нажаль, в API відсутній доступ до редагування позначок розрізів та виносних видів, таким чином код не додає сторінку аркуша до позначки на якому знаходиться вид. Це доведеться робити руками, якщо хочете оформлення по ЕСКД.
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Дякую! Це дуже корисно. Якраз у мене були такі питання. Ви на них повністю відповіли. Дякую!
Вітаю @anton.mashkin.ua !
Дякую за Ваш відгук, це корисно для розвитку макросу.
З останньої публікації я знайшов багато недоліків, серед них були і Вами озвученні.
Тож нова версія значно продвинутіша, але аби використовувати її на максимум потрібно робити редагування у самому коді вручну:
Sub main
Dim oInvApp As Inventor.Application = ThisApplication
Dim oDraw As DrawingDocument = TryCast(oInvApp.ActiveDocument, DrawingDocument)
If oDraw Is Nothing Then Exit Sub
Dim oTM As TransactionManager = oInvApp.TransactionManager
Dim oSheets As Sheets = oDraw.Sheets
Dim oFirstView As DrawingView = GetFirstView(oSheets)
If oFirstView Is Nothing Then Exit Sub
Dim o1stViewScale As String = oFirstView.ScaleString
Dim oView_Number As String = "<StyleOverride Font='" & sStyleT & "' FontSize='" & dHT & "'><DrawingViewName/></StyleOverride>"
Dim oView_Scale As String = "<StyleOverride Font='" & sStyleT & "' FontSize='" & dHT & "'> (<DrawingViewScale/>)</StyleOverride>"
Dim oView_Name As String
Dim numbList As New ArrayList
Dim newTM As Transaction = oTM.StartTransaction(oDraw, "ChangeViewsName")
For i As Integer = 1 To oSheets.Count
numbList.Add(oSheets(i).Name)
Next
For Each oSheet As Sheet In oSheets
For Each oView As DrawingView In oSheet.DrawingViews
If Not oView.ShowLabel Then Continue For
Dim sNameView As String = oView.Label.FormattedText
If o1stViewScale = oView.ScaleString Then
oView_Name = oView_Number
Else
oView_Name = oView_Number & oView_Scale
End If
If Not IsNothing(oView.ParentView) Then
If oView.ViewType = DrawingViewTypeEnum.kAuxiliaryDrawingViewType Or
oView.ViewType = DrawingViewTypeEnum.kDetailDrawingViewType Or
oView.ViewType = DrawingViewTypeEnum.kProjectedDrawingViewType Then
oView.Name = GetLetters()
iDetailCount += 1
Else If oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType Then
' oView.Name = GetLetters()
' iDetailCount += 1
oView.Name = iSectionCount
iSectionCount += 1
Else
Continue For
End If
Dim sSheetName As String = oView.ParentView.Parent.Name
If oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType _
And oView.Label.Text.Contains("-") Then
sNameView = oView_Number & "-" & oView_Name
Else
sNameView = oView_Name
End If
If sSheetName <> oView.Parent.Name Then
sNameView = sNameView & "<StyleOverride Font='" & sStyleT & "' FontSize='" & dHT & "'> (" &
numbList.IndexOf(sSheetName) + 1 & ")</StyleOverride>"
End If
Else
sNameView = oView_Name
End If
If oView.Rotation = 0 Then
oView.Label.FormattedText = sNameView
Else
sNameView = CheckRotateView(oView.Rotation, sNameView)
If sNameView Is Nothing Then Continue For
Try : oView.Label.FormattedText = sNameView
Catch : End Try
End If
oView.Label.TextStyle.Italic = True
Next
Next
newTM.End()
End Sub
Dim sStyleT As String = "GOST Common" ' Стиль тексту
Dim dHT As Double = 0.5 ' Висота тексту у сантиметрах
Dim cLetter() As Char = {"I", "O", "Q", "Z" }
'Dim cLetter() As Char = {"З", "И", "О", "Х", "Ч", "Ъ", "Ы", "Ь", "Э"}
Dim iCL As Integer = 26 'англ - 26, укр - 32
Dim iCL2 As Integer = iCL * iCL
Dim iSL As Integer = 64 'англ - 64, укр - 191
Dim iDetailCount As Integer = 1
Dim iSectionCount As Integer = 1
Private Function GetFirstView(ByVal oSheets As Sheets) As DrawingView
For iSheet As Integer = 1 To oSheets.Count
If oSheets(iSheet).DrawingViews.Count = 0 Then Continue For
Return oSheets(iSheet).DrawingViews(1)
Next
Return Nothing
End Function
Private Function GetLetters() As String
BeakLetters :
i = iDetailCount
Dim sNameView As String
Dim c1, c2, c3 As Char
If i > iCL Then
If i > iCL2 + iCL Then
Dim iCount As Integer = Floor((i-iCL-1) / iCL2)
Dim iStep As Integer = (iCount * iCL2) + iCL
c1 = Chr(((i - 1) Mod iCL) + iSL + 1)
If cLetter.Contains(c1) Then iDetailCount += 1 : GoTo BeakLetters
c2 = Chr(Int((i - iStep - 1) / iCL) + iSL + 1)
If cLetter.Contains(c2) Then iDetailCount += 1 : GoTo BeakLetters
c3 = Chr(Int(iCount) + iSL)
If cLetter.Contains(c3) Then iDetailCount += 1 : GoTo BeakLetters
sNameView = c3 & c2 & c1
Else
c1 = Chr(((i - 1) Mod iCL) + iSL + 1)
If cLetter.Contains(c1) Then iDetailCount += 1 : GoTo BeakLetters
c2 = Chr(Int((i - 1) / iCL) + iSL)
If cLetter.Contains(c2) Then iDetailCount += 1 : GoTo BeakLetters
sNameView = c2 & c1
End If
Else
c1 = Chr(i + iSL)
If cLetter.Contains(c1) Then iDetailCount += 1 : GoTo BeakLetters
sNameView = c1
End If
Return sNameView
End Function
Private Function CheckRotateView(ByVal dRot As Double, ByVal sNameView As String) As String
Dim dDeg As Double = Round(dRot * 180 / PI, 2)
Do While dDeg > 360.01
dDeg = dDeg - 360
Loop
If dDeg <> 0 And dDeg <> 360 Then
Dim sDeg, sRotate As String
If Abs(dDeg) < 180.01 Then
sDeg = Abs(dDeg) & ChrW(176)
If dDeg < 0 Then : sRotate = ChrW(&H21B7)
Else : sRotate = ChrW(&H21B6)
End If
Else
sDeg = Abs(dDeg) - 180 & ChrW(176)
If dDeg < 0 Then : sRotate = ChrW(&H21B6)
Else : sRotate = ChrW(&H21B7)
End If
End If
Return sNameView & " <StyleOverride Italic='False' Font='@Arial Unicode MS' FontSize='" & dHT+0.3 & "'>" _
& sRotate & " </StyleOverride>" & sDeg
End If
Return Nothing
End Function
Нажаль, не вдалося відслідкувати баг з невідповідністю значень повороту. Можливо це виправив раніше та тепер небачу проблем. Спробуйте нову версію, та залишіть відгук. Дякую!
* - Насправді, це не український алфавіт, а москальський. Це пов'язано з тим, що літери я беру з системи, а там лише кацапська. Тому, серед літер у рядку 83 є ті, що притамані гидкій мові.
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
Can't find what you're looking for? Ask the community or share your knowledge.