Vytisknout stránku | Zavřít okno

iLogic Title Block

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=29600
Datum vytištění: 06.kvě.2026 v 11:26


Téma: iLogic Title Block
Odeslal: PopelkaM
Předmět: iLogic Title Block
Datum odeslání: 01.lis.2019 v 09:40
Dobrý den,
pokouším se iLogicem vyměnit staré razítko za nové ve výkrese viz. pravidlo níže.
Nové razítko vloží do zdrojů výkresu ,ale nevloží do výkresu.

Problém je ,že razítko má texty s výzvou a to není v pravidle ošetřeno....

Poradí mě někdo...

Děkuji Popelka


---------------------------------------------------------------------------
ThisDrawing.ResourceFileName = "cesta ksouboru idw"
ThisDrawing.KeepExtraResources = False
Dim oSheets As Sheets
oDoc = ThisDoc.Document
Dim oSheet As Sheet
    For Each oSheet In oDoc.Sheets
        oSheet.Activate
            ActiveSheet.TitleBlock = "nové razítko"
            Next


Odpovědi:
Odeslal: Navara
Datum odeslání: 01.lis.2019 v 11:21
Tohle je trochu složitější úloha. Podle mě na to iLogic žádnou zvláštní podporu neposkytuje a je potřeba to udělat přes plné API.
V nápovědě k API Inventrou je uveden příklad ve VBA na definici a vložení rohového razítka, který není problém upravit pro iLogic.
Příklad najdete pod heslem 
TitleBlock Object
 (kopírovat ho sem nebudu)

Pro vložení razítka je potřeba použít přímo metodu 
Sheet.AddTitleBlock Method
a pokud nové razítko obsahuje zadání s výzvou, je argument 
PromptStrings
povinný a musí obsahovat přesně daný počet textů, který odpovídá počtu výzev v razítku v pořadí, v jakém se výzvy zadávají do razítka.

Pokud i původní razítko obsahuje vyplněná zadání s výzvou, které je potřeba přenést, tak se situace ještě více komplikuje, protože je potřeba tyto hodnoty před vymazáním razítka přečíst a správně zapsat do nového razítka.

Odeslal: PopelkaM
Datum odeslání: 01.lis.2019 v 13:46
Děkuji za info.
Vkládání funguje...

Makro níže počítá s tím ,že razítko je ve zdrojích aktuálního výkresu.
Potřebuji udělat to co bylo v iLogicu.
Aby se razítko do výkresu zkopírovalo ze souboru *.idw.
Můžete mě ještě poradit?

Děkuji Popelka

--------------------------------------------------------------------------------------
Public Sub InsertTitleBlockOnSheet()
    ' Set a reference to the drawing document.
    ' Nastavte odkaz na výkresový dokument
   
    ' This assumes a drawing document is active.
       Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument

    ' Obtain a reference to the desired border defintion.
      
    Dim oTitleBlockDef As TitleBlockDefinition
    Set oTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item("CNHI")

    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet

    ' Check to see if the sheet already has a title block and delete it if it does.
      
    If Not oSheet.TitleBlock Is Nothing Then
        oSheet.TitleBlock.Delete
    End If

    ' This title block definition contains one prompted string input.  An array
   
    ' must be input that contains the strings for the prompted strings.'
       
    Dim sPromptStrings(1 To 22) As String
    sPromptStrings(1) = ""
    sPromptStrings(2) = ""
    sPromptStrings(3) = ""
    sPromptStrings(4) = ""
    sPromptStrings(5) = ""
    sPromptStrings(6) = ""
    sPromptStrings(7) = ""
    sPromptStrings(8) = ""
    sPromptStrings(9) = ""
    sPromptStrings(10) = ""
    sPromptStrings(11) = ""
    sPromptStrings(12) = ""
    sPromptStrings(13) = ""
    sPromptStrings(14) = ""
    sPromptStrings(15) = ""
    sPromptStrings(16) = ""
    sPromptStrings(17) = ""
    sPromptStrings(18) = ""
    sPromptStrings(19) = ""
    sPromptStrings(20) = ""
    sPromptStrings(21) = ""
    sPromptStrings(22) = ""

   
    ' Add an instance of the title block definition to the sheet.
    Dim oTitleBlock As TitleBlock
    Set oTitleBlock = oSheet.AddTitleBlock(oTitleBlockDef, , sPromptStrings)
End Sub

Odeslal: Navara
Datum odeslání: 01.lis.2019 v 14:20
Třeba takhle
Dim sourceIdw As DrawingDocument = ThisApplication.Documents.Open("C:\Source.idw")
Dim targetIdw As DrawingDocument= ThisApplication.Documents.Open("C:\Target.idw")
Dim replaceExisting As Boolean = True

Dim sourceTitleBlockDef As TitleBlockDefinition = sourceIdw.TitleBlockDefinitions("TitleBlockName")
Dim targetTitleBlockDef As TitleBlockDefinition = sourceTitleBlockDef.CopyTo(targetIdw,replaceExisting)

Odeslal: PopelkaM
Datum odeslání: 01.lis.2019 v 14:42
Děkuji za ochotu vyzkouším...Popelka


Vytisknout stránku | Zavřít okno