https://www.cadforum.cz/forum/ Wed, 15 Apr 2026 02:53:06 +0000 Sun, 29 Mar 2026 20:13:04 +0000 http://blogs.law.harvard.edu/tech/rss Web Wiz Forums 12.04 360 https://www.cadforum.cz/forum/RSS_post_feed.asp?TID=35904 https://www.cadforum.cz/forum/forum_images/web_wiz_forums.png https://www.cadforum.cz/forum/ https://www.cadforum.cz/forum/forum_posts.asp?TID=35904&PID=131615&title=pruvodka-generovana-z-inventoru#131615 Autor: madep
Předmět: 35904
Zasláno: 29.bře.2026 v 20:13

Kolegové,
kdysi jsem odsud stáhnul pravidlo na generování průvodky z modelu.
Trochu jsem ho upravil, protože ten původní do průvodky generoval barevný obrázek s pozadím, což nebylo úplně dobré, zvláště když to tisknu na černobílé tiskárně, což pro výrobu stačí.
Důležité je mít v Možnostech uložení obrázku zaškrtnuté "Průhledné pozadí"
V Šabloně WORD jsou na místě generování iVlastností vytvořené záložky, ale samozřejmě si je můžete upravit podle sebe.
Tak kdyby to někomu pomohlo, tak tady je:


'název šablony protokolu
template = "C:\Vault\Šablony\Šablony\Pruvodka.docx"

'objekt aplikace Word
wordApp = Interaction.CreateObject("Word.Application")

'načíst šablonu do Wordu
wordDoc = wordApp.Documents.Add (template, Visible:=True)

'zapsat hodnoty z modelu do Záložek šablony - možno doplňovat další pole
wordDoc.Bookmarks("TITLE").Range.Text = iProperties.Value("Summary", "Title")
wordDoc.Bookmarks("PARTNO").Range.Text = iProperties.Value("Project", "Part Number")
wordDoc.Bookmarks("STOCK_NUMBER").Range.Text = iProperties.Value("Project", "Stock number")
wordDoc.Bookmarks("DESCRIPTION").Range.Text = iProperties.Value("Project", "Description")
wordDoc.Bookmarks("REVNO").Range.Text = iProperties.Value("Project", "Revision Number")

'vytvořit náhled
oImage = ThisDoc.PathAndFileName(False) & ".png"
oCamera = InventorVb.Application.ActiveView.Camera
oCamera.fit
oCamera.apply
'InventorVb.Application.ActiveView.SaveAsBitmap(oImage,700,400 )
'získat aktuální režim zobrazení
Dim oOGDisplayMode As DisplayModeEnum = InventorVb.Application.ActiveView.DisplayMode
'change to wireframe w/o hidden edges
InventorVb.Application.ActiveView.DisplayMode = DisplayModeEnum.kWireframeNoHiddenEdges
InventorVb.Application.ActiveView.Update()

'přiřadit možnosti mapy názvů a hodnot
Dim oOptions As NameValueMap
oOptions = InventorVb.Application.TransientObjects.CreateNameValueMap
oOptions.Value("Transparent Background") = True

'Pro nastavení velikosti použijte příkaz saveasbitmap
'protože nedokážu zjistit správné možnosti pro danou velikost, takže to používám jako alternativní řešení
InventorVb.Application.ActiveView.SaveAsBitmap(oImage, 400, 400)
'export s průhledným pozadím (nutno uložit jako PNG)
ThisDoc.Document.SaveAs2(oImage, True, oOptions)

'návrat do původního režimu zobrazení
InventorVb.Application.ActiveView.DisplayMode = oOGDisplayMode
InventorVb.Application.ActiveView.Update()

'vložit na konec
wordDoc.Bookmarks.Item("\endofdoc").Range.InlineShapes.AddPicture(oImage)
My.Computer.FileSystem.DeleteFile(oImage)

'uložit Word k modelu
wordDoc.SaveAs (ThisDoc.PathAndFileName(False) & ".docx")
'Dim WordFileName As String
'WordFileName=environmentPath1 & "Vstupní kontrola" & ThisDoc.FileName(False) & ".docx"
'wordDoc.SaveAs (WordFileName)
wordDoc.Close()
wordDoc = Nothing


'ukončit Word
wordApp.Application.Quit()
wordApp=Nothing
Šablona_WORD.zip]]> Sun, 29 Mar 2026 20:13:04 +0000 https://www.cadforum.cz/forum/forum_posts.asp?TID=35904&PID=131615&title=pruvodka-generovana-z-inventoru#131615