Vytisknout stránku | Zavřít okno

Tisk pomocí VBA

Vytištěno z: CAD Fórum
Kategorie: Autodesk - stavebnictví, strojírenství, CAD/GIS
Název fóra: CAD programování
Popis fóra: Otázky programování - nadstavby a utility pro CAD a GIS aplikace Autodesk (VBA, AutoLISP, ARX/C++, .Net, JavaScript, Python, MEL...)
URL: https://www.cadforum.cz/forum/forum_posts.asp?TID=11651
Datum vytištění: 15.kvě.2026 v 18:43


Téma: Tisk pomocí VBA
Odeslal: paveku
Předmět: Tisk pomocí VBA
Datum odeslání: 10.říj.2010 v 21:07

Dobrý den,

potřeboval bych vědět, jak pomocí VBA naprogramovat tisk několika záložek výkresového prostoru. Super by bylo, aby jsem mohl změnou kódu ovládat i pořadí v jakém se to vytiskne. Trochu znám VBA v Excelu, ale tady mě to nejde. Nevím, jak vybrat záložku výkresového prostoru. 




Odpovědi:
Odeslal: Vladimír Michl
Datum odeslání: 10.říj.2010 v 21:20
Podívejte se v helpu na metodu Plot.SetLayoutsToPlot
 
Jen pozor, podpora VBA (Microsoftem) skončila už před mnoha lety a z AutoCADu bude VBA také v nejbližších verzích odstraněn.


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


Odeslal: paveku
Datum odeslání: 12.říj.2010 v 21:02

Tak jsem se s tím potýkal 2 dny, ale nemohu na to přijít co dělám blbě. Použil jsem postup :

Dim proTisk(1 To 4)
    For i = 1 To 4
            proTisk(i) = ThisDrawing.Layouts(i).Name
    Next i

ThisDrawing.Plot.StartBatchMode i
    For j = 1 To i
           ThisDrawing.Plot.SetLayoutsToPlot proTisk
           ThisDrawing.Plot.PlotToDevice
    Next j

Na řádku "ThisDrawing.Plot.SetLayoutsToPlot proTisk" se objeví chyba chybná procedůra nebo argument. 




Odeslal: v.klazar
Datum odeslání: 13.říj.2010 v 10:56
mozna to nechapu dobre, ale nemelo by next i byt na konci?


Odeslal: paveku
Datum odeslání: 13.říj.2010 v 11:57
Podle helpu jsem to pochopil tak, že se nejprve naplní pole názvy rozvržení -
    For i = 1 To 4
            proTisk(i) = ThisDrawing.Layouts(i).Name
    Next i
 
a pak se opakovaně spouští tisk -
    For j = 1 To i
           ThisDrawing.Plot.SetLayoutsToPlot proTisk
           ThisDrawing.Plot.PlotToDevice
    Next j


Odeslal: Martin Bielina
Datum odeslání: 13.říj.2010 v 13:35
Původně odeslal(a) paveku paveku napsal(a):

Podle helpu jsem to pochopil tak, že se nejprve naplní pole názvy rozvržení -
    For i = 1 To 4
            proTisk(i) = ThisDrawing.Layouts(i).Name
    Next i

'
'do i bude po skončení cyklu přičtena hodnota 1 (default step)
'tedy i=5 !!!!
'

a pak se opakovaně spouští tisk -
    For j = 1 To i
           ThisDrawing.Plot.SetLayoutsToPlot proTisk
           ThisDrawing.Plot.PlotToDevice
    Next j

Možná to pro vás bude překvapení, ale ale víte vůbec, že pokud se budete ve druhém cyklu For odvolávat na i jako horní hranici, tak se nebude v tomto případě jednat o číslo 4 ale 5?

Pokud mají oba cykly proběhnou 4x, pak bych i ten druhý zavedl znovu jako i tedy:

   For i = 1 To 4
           ThisDrawing.Plot.SetLayoutsToPlot proTisk
           ThisDrawing.Plot.PlotToDevice
    Next i

Ubyde vám tím jedna zbytečná proměnná... a ten zbytek, tu už bude váš boj.



Odeslal: paveku
Datum odeslání: 13.říj.2010 v 17:45

Jo jasně, dík za upozornění, ale stále to nefunguje jak má ! ! !

Pomůže někdo ?



Odeslal: pavelstyl
Datum odeslání: 14.říj.2010 v 05:48
Původně odeslal(a) Martin Bielina Martin Bielina napsal(a):

 
For i = 1 To 4
 . . .
Next i
'
'do i bude po skončení cyklu přičtena hodnota 1 (default step)
'tedy i=5 !!!!
'

To se mi moc nezdá ... jste si tím jistý?

Pavel Štyl



Odeslal: Martin Bielina
Datum odeslání: 14.říj.2010 v 13:42
[/QUOTE]

To se mi moc nezdá ... jste si tím jistý?

Pavel Štyl

[/QUOTE]

Ano, u VBA jsem si tím jistý. Next i na konci cyklu vždy přičte k i hodnotu kroku, a to i v případě, kdy se jedná o "poslední kolo" cyklu. Není přece nic jednoduššího, než si to vyzkoušet na jednoduchém případu kdy v cyklu For budete mít jen výpis hodnoty i a pak po skončení cyklu ještě jednou provedete výpis hodnoty i.

Obzvlášť nebezpečný je případ, kdy se i deklaruje jako např. typ INTEGER a jeho horní mez je počtem cyklů právě (přesně) dosažena, protože po skončení cyklu dojde k "poslednímu přičtení" a tím i k přetečení proměnné.

A omlouvám se, že původní dotaz na řešení problému se i mojí vinou poněkud zvrnul v nežádoucí diskuzi jak co funfuje. VBA je mrtev, v Autocadu bych se už s jeho existencí vůbec nezabýval. Je jen otázkou času, kdy zmizí zcela.



Odeslal: paveku
Datum odeslání: 15.říj.2010 v 06:42

jj, všechno chápu, znám trochu VBA z Excelu ,a nic jiného. Potřebuji jen vyřeštit problém toho tisku, protože to chci spouštět z excelu.

POMŮŽE NĚKDO ? ? ?
===============


Odeslal: VopluDa
Datum odeslání: 15.říj.2010 v 11:04
a co tohle:
 
Sub SetLayoutsToPlot()
   
    Dim oPlot As AcadPlot
    Dim AddedLayouts() As String
    Dim LayoutList As Variant
    Dim oLayout As AcadLayout
    Dim ArraySize As Integer, BatchCount As Integer
    Dim retVal As String
    Dim MyValue
       
    For Each oLayout In ThisDrawing.Layouts
        ArraySize = ArraySize + 1
        ReDim Preserve AddedLayouts(1 To ArraySize)
        MyValue = InputBox("Vytisknout A/N?", oLayout.Name, "A")
            If MyValue = "A" Or MyValue = "a" Then AddedLayouts(ArraySize) = oLayout.Name
    Next
    LayoutList = AddedLayouts
    Set oPlot = ThisDrawing.Plot
    oPlot.SetLayoutsToPlot LayoutList
    oPlot.PlotToDevice
End Sub
 
je to silne surovy bez ladu a skladu s minimem casu tomu a jen pro inspiraci  Wink


Odeslal: paveku
Datum odeslání: 15.říj.2010 v 16:29

Super, díky moc, již to funguje. Teď jdu hledat, kde jsem dělal chybu




Odeslal: paveku
Datum odeslání: 10.lis.2010 v 18:24
Ještě se vracím k tomuto tematu. Vše funguje jak má, ale otravuje mě blikání při přepínání mezi jednotlivými záložkami. Lze to potlačit, něco jako tisk na pozadí. Něco jako v excelu "ScreenUpdating = False" ?


Odeslal: VopluDa
Datum odeslání: 11.lis.2010 v 08:40
zkousel sem to a neblika mi to, zalozky se mi pri vyberu neprepinaji. si ale myslim, ze to je nastavenim nejaky promenny Cadu, na kterou si moje potvora hlava mapa duta prave nechce vzpomenout
 
este sem si s  tim pak malinko hral, spis jen kosmeticky:
 
Sub SetLayoutsToPlot()
   
    Dim oPlot As AcadPlot
    Dim AddedLayouts() As String
    Dim LayoutList As Variant
    Dim oLayout As AcadLayout
    Dim ArraySize As Integer, BatchCount As Integer
    Dim MyValue
    Dim Style, Title
   
    Style = vbYesNoCancel + vbQuestion + vbDefaultButton2
    Title = "A co dál?"
       
    For Each oLayout In ThisDrawing.Layouts
    ArraySize = ArraySize + 1
    ReDim Preserve AddedLayouts(1 To ArraySize)
    MyValue = MsgBox("      Vytisknout " & oLayout.Name & " ?", Style, Title)
            If MyValue = vbYes Then
                                AddedLayouts(ArraySize) = oLayout.Name
              ElseIf MyValue = vbCancel Then
                                GoTo Line1
            End If
    Next
   
    LayoutList = AddedLayouts
    Set oPlot = ThisDrawing.Plot
    oPlot.SetLayoutsToPlot LayoutList
    oPlot.PlotToDevice
 
Line1:
    ThisDrawing.ActiveSpace = acModelSpace
 
End Sub


Odeslal: paveku
Datum odeslání: 23.lis.2010 v 17:10

Nevíte někdo, jak odstranit to blikání a přepínání záložek při tisku?

Už mě to docela začíná otravovat. Jinak to maká perfektně.




Odeslal: VopluDa
Datum odeslání: 24.lis.2010 v 13:52

prubni tohle:

 
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long

Sub SetLayoutsToPlot()
   
    Dim oPlot As AcadPlot
    Dim AddedLayouts() As String
    Dim LayoutList As Variant
    Dim oLayout As AcadLayout
    Dim ArraySize As Integer, BatchCount As Integer
    Dim MyValue
    Dim Style, Title
 
    Style = vbYesNoCancel + vbQuestion + vbDefaultButton2
    Title = "A co dál?"
       
       
    For Each oLayout In ThisDrawing.Layouts
    ArraySize = ArraySize + 1
    ReDim Preserve AddedLayouts(1 To ArraySize)
    MyValue = MsgBox("      Vytisknout " & oLayout.Name & " ?", Style, Title)
            If MyValue = vbYes Then
                                AddedLayouts(ArraySize) = oLayout.Name
              ElseIf MyValue = vbCancel Then
                                GoTo Line1
            End If
   
    Next
   
    LockWindowUpdate (ThisDrawing.hWnd)
   
   
    LayoutList = AddedLayouts
    Set oPlot = ThisDrawing.Plot
    oPlot.SetLayoutsToPlot LayoutList
    oPlot.PlotToDevice

    LockWindowUpdate (0)

Line1:
    ThisDrawing.ActiveSpace = acModelSpace

End Sub
 
 
ale na rychlosti to neprida jako u excelu "ScreenUpdating = False"   Wink


Odeslal: paveku
Datum odeslání: 24.lis.2010 v 17:55
Výborné, pomohlo to na přeskakování listů. Teď už jen problikává okno "Postup vykreslování". Šlo by i to potlačit?


Odeslal: VopluDa
Datum odeslání: 25.lis.2010 v 10:09
sorry, budu uprimnej. jak potlacit prepinani zalozek, to zajimalo i mne. mam jeste par veci v vba, ktery jeste nemam predelany do lispu a tak sem to pouzil tam. ale jak uz tady bylo receno, vba je mrtvy. neni tedy prinos venovat cas a energii vyvoji cehokoliv noveho v vba, natoz ladit neco k dokonalosti.



Vytisknout stránku | Zavřít okno