iLogic a ETO - Změna rámečku na výkrese

Změna rámečku na výkrese - VBA

Vytištěno z: CAD Fórum
Kategorie: Autodesk - stavebnictví, strojírenství, CAD/GIS
Název fóra: iLogic a ETO
Popis fóra: Funkce a makra iLogic, Inventor Engineering to Order (ETO), automatizace a konfigurace výrobků
URL: https://www.cadforum.cz/forum/forum_posts.asp?TID=19861
Datum vytištění: 06.kvě.2026 v 18:17

Téma: Změna rámečku na výkrese - VBA

Odeslal: jirka007CZ
Předmět: Změna rámečku na výkrese - VBA
Datum odeslání: 05.zář.2014 v 09:32

Dobrý den, ve firmě používáme několik druhů rámečků výkresů. Než je výkresová dokumentace schválená, tak máme rámeček s příčným vodoznakem "informativní". Po schválení dokumentace měníme rámeček na totožný, ale bez vodoznaku. Obdobně máme řešené speciální listy s kusovníkem.

Cílem je zjednodušit tuto změnu...snížit počet kliků. Vydal jsem se cestou "čudlíku", který tyto kroky provede přes VBA makro. Základní kód jsem získal na zahraničním fóru a v zásadě funguje dobře. Jediným problémem je, že z našich rámečků odstraní horizontální a vertikální zóny. Další vadou je, že změnu provádí na všech výkresech.

Rád bych touto cestou poprosil o radu jak kód upravit ku prospěchu věci, tudíž rámečky se zónami a změna rámečku pouze na aktivním listu. Moc děkuji za radu, kód níže.

Public Sub InsertCustomBorderOnSheet()

' Set a reference to the drawing document.

' This assumes a drawing document is active.

Dim oDrawDoc As DrawingDocument

Set oDrawDoc = ThisApplication.ActiveDocument

' Obtain a reference to the desired border definition.

Dim oBorderDef As BorderDefinition

Set oBorderDef = oDrawDoc.BorderDefinitions.Item("Název požadovaného rámečku")

' Set a reference to count all sheets in document

Dim oSheets As Sheets

Set oSheets = oDrawDoc.Sheets

Dim iSheets As Integer

For iSheets = 1 To oSheets.Count

' Check to see if the sheet already has a border and delete it if it does.

If Not oSheets(iSheets).Border Is Nothing Then

oSheets(iSheets).Border.Delete

End If

' Add an instance of the border definition to the sheet.

Dim oBorder As Border

Set oBorder = oSheets(iSheets).AddBorder(oBorderDef)

End Sub

-------------
Chyba je vždy mezi monitorem a židlí...

Odpovědi:

Odeslal: Navara
Datum odeslání: 05.zář.2014 v 11:02

Úprava tak, aby se měnil rámeček na aktuálním listu je jednoduchá

Public Sub InsertCustomBorderOnActiveSheet()
    ' Set a reference to the drawing document.
    ' This assumes a drawing document is active.
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    ' Obtain a reference to the desired border definition.
    Dim oBorderDef As BorderDefinition
    Set oBorderDef = oDrawDoc.BorderDefinitions.Item("Watermark")
    ' Set a reference to active sheet
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    ' Check to see if the sheet already has a border and delete it if it does.
    If Not oSheet.Border Is Nothing Then
        oSheet.Border.Delete
    End If
    ' Add an instance of the border definition to the sheet.
    Dim oBorder As Border
    Set oBorder = oSheets(iSheets).AddBorder(oBorderDef)
End Sub

S tím mizením zón je to horší, protože to vypadá na nějakou chybu Autodesku. Doporučuju si dát trochu práce a namalovat si vlastní rámeček se zónami a nepoužívat ten výchozí, nebo automaticky generovaný.

Další možnost je neměnit rámeček, ale do rámečku doplnit textové pole, které bude zobrazovat nějakou iVlastnost výkresu a pokud bude její hodnota prázdná, tak se žádný vodoznak nezobrazí. Jinak tam můžete mít libovolný text.

Odeslal: jirka007CZ
Datum odeslání: 05.zář.2014 v 13:42

Dobrý den, moc děkuji za radu a upravený kód. Bohužel v předposledním řádku funkce zkolabuje.

Set oBorder = oSheets(iSheets).AddBorder(oBorderDef)

Následně vyhlásí chybu:

Sub or Function not defined.

Textové pole s ivlastností nebo i statickým textem jsem byl nucený v prvopočátku mého snažení zavrhnout. Důvod byly různé formáty výkresů. Text ve výkresu se mi nepodařilo přemluvit, aby se přizpůsobovalo různým formátům listů. Tudíž východiskem se staly různé rámečky se statickým vodoznakem pro všechny používané formáty listu a jeden rámeček bez textu univerzální pro všechny formáty.

-------------
Chyba je vždy mezi monitorem a židlí...

Odeslal: Vladimír Michl
Datum odeslání: 05.zář.2014 v 15:47

Zřejmě tam má být "oSheet.AddBorder(oBorderDef)" - jde o to zda pracujete s aktuálním listem nebo se všemi.

-------------
Vladimír Michl (moderátor)
ARKANCE CZ - https://arkance.world - arkance.world
(podpora viz helpdesk.arkance-systems.cz)

Odeslal: jirka007CZ
Datum odeslání: 08.zář.2014 v 14:24

Dobrý den, děkuji moc, funkce již pracuje jak má. Ještě nějakým způsobem vyřeším problém s mizejícími zónami a bude to dokonalé.

Ještě jednou moc děkuji.

-------------
Chyba je vždy mezi monitorem a židlí...