napisał: tommy
postów: 42
 umieszczony:
2 listopada 2007
12:53
|
|
Witam
Napisałem sobie makro do drukowania z obszaru modelu (przy częściowym wykorzystaniu poniższych informacji )
Mam pytanie jak lepiej rozwiązać pętle bo wiem, że pewnie da się "ładniej"
W niektórych rysunkach makro wysypuje mi się na linii
layout.PaperUnits = acMillimeters
i kompletnie nie wiem dlaczego.
Probował ktoś może drukować do drukarki Adobe PDF ?? Jak bym nie ustawiał to coś jest nie tak, jak już drukuje to robi pliki PLT, a jeśli dodam w nazwie rozszerzenie PDF to nie da się tego później otworzyć
Przy drukarce "DWG To PDF.pc3" drukuje bardzo grubo tekst (np tahoma), a nie potrafie znaleźć jakiejś zmiennej która za to opowiada.
Poniżej kod makra
Sub Print_Cuttlist()
Dim layout As AcadLayout
Dim Plot As AcadPlot
Dim ArkuszeDoWydruku(0) As String
Dim licznik As Integer
Dim PDFName As String
Dim PDFPreNumber As String
PDFPreNumber = ThisDrawing.Utility.GetString(1, "Podaj przedrostek: ")
If PDFPreNumber <> "" Then PDFPreNumber = PDFPreNumber & "-"
licznik = 1
drukowanie:
For Each layout In ThisDrawing.Layouts
With layout
If .Name = "Model" Then
'qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq
Dim layer As AcadLayer
Dim layers As AcadLayers
Set layers = ThisDrawing.layers
Dim corner1(0 To 1) As Double
Dim corner2(0 To 1) As Double
pt = ThisDrawing.Utility.GetPoint(, "Wskaż lewy górny narożnik: " & "Strona: " & licznik)
On Error GoTo KONIEC ' koniec drukowania
'warstwa wydruku
Set layer = ThisDrawing.layers.Add("!D-Print")
layer.Plottable = False
layer.color = acRed
'punkt poczatkowy (lewy gorny)
Dim point As AcadPoint
Set point = ThisDrawing.ModelSpace.AddPoint(pt)
point.layer = "!D-Print"
point.color = acByLayer
corner1(0) = pt(0): corner1(1) = pt(1) - 5580
corner2(0) = corner1(0) + 3940: corner2(1) = corner1(1) + 5580
'qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq
Dim plotFileName As String
'plotFileName = "PublishToWeb JPG.pc3"
'plotFileName = "Adobe PDF.pc3"
plotFileName = "DWG to PDF.pc3"
layout.CenterPlot = True
layout.StandardScale = acScaleToFit
'jednostki rysunku milimetry
layout.PaperUnits = acMillimeters
layout.SetWindowToPlot corner1, corner2
layout.GetWindowToPlot corner1, corner2
layout.PlotType = acWindow 'acExtents
'layout.ConfigName = "Adobe PDF.pc3"
layout.ConfigName = "DWG to PDF.pc3"
'layout.ConfigName = "PublishToWeb JPG.pc3"
'rodzaj papieru papieru
'layout.CanonicalMediaName = "A4"
layout.CanonicalMediaName = "ISO_expand_A4_(210.00_x_297.00_MM)"
'orientacja
layout.PlotRotation = ac0degrees
'czy wyswietlac style wydruku
layout.PlotWithPlotStyles = True
layout.ShowPlotStyles = True
layout.PlotHidden = False
layout.PlotWithLineweights = True
'zmiana Tablicy wydruku
layout.StyleSheet = "Dolpos1.ctb"
ArkuszeDoWydruku(0) = .Name
Set Plot = ThisDrawing.Plot
With Plot
.SetLayoutsToPlot (ArkuszeDoWydruku)
.PlotToFile (PDFPreNumber & licznik)
End With
Set Plot = Nothing
End If
End With
Next layout
licznik = licznik + 1
GoTo drukowanie
KONIEC:
Err.Clear
End Sub
Będę wdzięczny za pomoc.
Pozdro
Tommy |
|
|
napisał: abo
postów: 13
umieszczony:
4 lutego 2007
11:42
 edytowany:
4 lutego 2007
11:44
|
|
generalnie używam PlotToDevice
znalazłem program do sortowania arkuszy po nazwie
jeżeli wycinam część kodu sortującą arkusze wg nazwy
to uzyskuje komunikat w jakiej kolejności arkusze są indeksowane
teraz nie wiem jak przerobić to żeby drukował w tej kolejności arkusze PlotToDevice
Sub SORTOWANIE_ARKUSZY()
'samo sortowanie indeksu arkuszy
Dim SortLayoutRight As ACADLayout, SortLayoutLeft As ACADLayout
Dim SortIt As New Collection
Dim TabCount As Long, SortCount As Long, TabOrder As Long
Dim TabName As String, SortText As String, msg As String
Dim tempLayout As ACADLayout
Dim AddedTab As Boolean
' Create new Layouts
On Error Resume Next
Set Layout1 = ThisDrawing.Layouts.Add("Z VIEW")
Set Layout2 = ThisDrawing.Layouts.Add("A VIEW")
On Error GoTo 0
' Alphabetize internally
For TabCount = 0 To (ThisDrawing.Layouts.Count - 1)
AddedTab = False
TabName = ThisDrawing.Layouts(TabCount).Name
If TabName = "Model" Then GoTo SKIP ' Skip modelspace
If SortIt.Count = 0 Then
SortIt.Add TabName ' Add to beginning of list
Else
For SortCount = 1 To SortIt.Count ' Add to list by string
SortText = SortIt(SortCount)
Next
' Add if we haven't yet
If Not (AddedTab) Then SortIt.Add TabName, , , SortIt.Count
End If
SKIP:
Next
' Write new ACAD tab order
For SortCount = 1 To SortIt.Count
Set tempLayout = ThisDrawing.Layouts(SortIt(SortCount))
tempLayout.TabOrder = SortCount
Next
'-------------------------------
' Read and display New Tab Order
'-------------------------------
msg = "The tab order is now set to: " & vbCrLf & vbCrLf
For TabCount = 0 To (ThisDrawing.Layouts.Count - 1)
TabName = ThisDrawing.Layouts(TabCount).Name
If TabName = "Model" Then GoTo SKIP2 ' Don't show modelspace
TabOrder = ThisDrawing.Layouts(TabCount).TabOrder
msg = msg & "(" & TabOrder & ")" & vbTab & TabName & vbCrLf
SKIP2:
Next
'Komunikat o kolejności arkuszy
'MsgBox msg, vbInformation
End Sub
############################################
po wycięciu cześci kodu mam jedynie komunikat z kolejnością arkuszy
Sub SORTOWANIE_ARKUSZY_wyswietlanie_kolejnosci()
Dim Layout1 As ACADLayout, Layout2 As ACADLayout
Dim SortLayoutRight As ACADLayout, SortLayoutLeft As ACADLayout
Dim SortIt As New Collection
Dim TabCount As Long, SortCount As Long, TabOrder As Long
Dim TabName As String, SortText As String, msg As String
Dim tempLayout As ACADLayout
Dim AddedTab As Boolean
' Write new ACAD tab order
For SortCount = 1 To SortIt.Count
Set tempLayout = ThisDrawing.Layouts(SortIt(SortCount))
tempLayout.TabOrder = SortCount
Next
For TabCount = 0 To (ThisDrawing.Layouts.Count - 1)
TabName = ThisDrawing.Layouts(TabCount).Name
If TabName = "Model" Then GoTo SKIP2 ' Don't show modelspace
TabOrder = ThisDrawing.Layouts(TabCount).TabOrder
msg = msg & "(" & TabOrder & ")" & vbTab & TabName & vbCrLf
SKIP2:
Next
MsgBox msg, vbInformation
End Sub |
|
|
napisał: pil
postów: 154
umieszczony:
4 lutego 2007
10:21
edytowany:
4 lutego 2007
11:09
|
|
@Abo - A jakiej metody używasz do plotowania - PlotToDevice czy PlotToFile? I jak się nazywają Twoje pliki z wydrukami?
Bo jeżeli PrintToFile, to jakoś tak to powinno wyglądać (pominąłem ustawienie wszystkich właściwości arkusz) :
Sub WydrukDoPlikow()
Dim layout As AcadLayout
Dim Plot As AcadPlot
Dim ArkuszeDoWydruku(0) As String
For Each layout In ThisDrawing.Layouts
With layout
If .Name <> "Model" Then
'...
'...
ArkuszeDoWydruku(0) = .Name
'...
Set Plot = ThisDrawing.Plot
With Plot
.SetLayoutsToPlot (ArkuszeDoWydruku)
.PlotToFile ("c:\downloads\" & layout.TabOrder &"_" & layout.Name & ".jpg")
End With
Set Plot = Nothing
End If
End With
Next layout
End Sub |
|
|
napisał: abo
postów: 13
umieszczony:
2 lutego 2007
22:09
edytowany:
2 lutego 2007
22:16
|
|
drukuje rysunki które mają po kilka kilkanaście arkuszy
sortowanie za każdym razem jest raczej żmudne
pokombinuje z tym co napisałeś..poniżej
wiem jak to ma być wykonane gorzej z napisaniem kodu
nawet jest przykład w VBA autocad: "Example_TabOrder"
na sortowanie ARKUSZY wg nazwy
po prostu trzeba odczytać jak lecą indeksy arkuszy np 1,3,5,2,4
i w takiej kolejności utworzyć kolekcję i wydrukować ją
ale nie jestem aż tak zaawansowany w VBA |
|
|
napisał: pil
postów: 154
umieszczony:
2 lutego 2007
21:59
|
|
| Przecież skoro plotujesz wszystko za jednym zamachem, to jakie ma znaczenie kolejność wydruków? Ale skoro się upierasz, to pokombinuj z ThisDrawing.Layouts.Count i Layout.TabOrder |
|
|
napisał: abo
postów: 13
umieszczony:
2 lutego 2007
21:13
|
|
jest jeszcze jeden problem:
jak drukujemy w ten sposób to
drukujemy wg kolejności indeksów ARKUSZY
a nam potrzeba drukować w kolejności jak są ustawione
jak można drukować kolejno następny widoczny ARKUSZ ? |
|
|
napisał: pil
postów: 154
umieszczony:
2 lutego 2007
07:41
|
|
Sam nie wiem. Tak jakoś ta pętla powinna wyglądać
'...
Dim Layout As AcadLayout
'...
For each Layout in ThisDrawing.Layouts
'test:
MsgBox "nazwa bieżącego arkusza : " & Layout.Name ' linia do skasowania
With Layout
If .Name <> "Model" Then 'tu wyskakuje ze zmienna nie ustalona
'...
End if
End With
Next Layout
'...
Jeżeli tak masz to zbudowane, i nie chce działać, to nie wiem. Może podeślij mi swój plik. |
|
|
napisał: abo
postów: 13
umieszczony:
1 lutego 2007
21:45
|
|
wyskoczył mo błąd przy wykonywaniu
With Layout
If .Name <> "Model" Then 'tu wyskakuje ze zmienna nie ustalona
'...
End if
End With
jaką zmienną jeszcze zadeklarować? |
|
|
napisał: pil
postów: 154
umieszczony:
1 lutego 2007
21:37
|
|
| Cytat: 1.
Option Explicit jeszcze tego nie używam
bo nie wiem co to jest coś tam od zmiennych ....poczytam
chyba że ktoś wcześniej mnie dokształci
Używaj. Zawsze i wszędzie. Tak w dwóch słowach - wymusza deklarowanie zmiennych i bardzo ułatwia życie, szczególnie przy literówce w nazwie zmiennej.
Pozdrawiam |
|
|
napisał: abo
postów: 13
umieszczony:
1 lutego 2007
21:10
|
|
1.
Option Explicit jeszcze tego nie używam
bo nie wiem co to jest coś tam od zmiennych ....poczytam
chyba że ktoś wcześniej mnie dokształci
2.
nazywanie aruszy - to z jakiegoś przykładu przyciąłem
3.
za obsługę błędów dzięki i za tworzenie nieobecnego katalogu
--na koniec--
makrami do autocada bawię się dopiero 5 dni
do excela pisałem dość duże makra
może się rozkręcę i w Acadzie
a cytowanie VBA poczytam jak to się robi |
|
|
napisał: pil
postów: 154
umieszczony:
31 stycznia 2007
22:51
edytowany:
1 lutego 2007
16:13
|
|
To może trochę kosmetyki?
Option Explicit 'nie wiem czy masz, ale powinna być
Sub Moje_Drukowanie_v2()
Dim objPlot As AcadPlot
Dim objLayouts() As String
Dim strPlotLocation As String
Dim Counter As Integer
Dim Layout As AcadLayout
Counter = 1
On Error GoTo koniec:
'choćby najprostsza obsługa błędów
'bo jest kilka miejsc , w których makro może się "wawalić"
Set objPlot = ThisDrawing.Plot
' katalog przeznaczenia plików przy "drukowaniu do pliku"
strPlotLocation = "c:\download"
'można jeszcze spróbować utworzyć katalog, jeżeli nie istnieje
If (Dir(strPlotLocation, vbDirectory) = "") Then
MkDir (strPlotLocation)
End If
For Each Layout In ThisDrawing.Layouts
'zamiast GoTo Etykieta
If Layout.Name <> "Model" Then
'Ustawienie podziałki drukowania
'Layout.StandardScale = acScaleToFit
'Centrowanie wydruku
'Layout.CenterPlot = True
'wybor drukarki
'...
'...
'nie bardzo rozumiem Twój sposób nazywania arkuszy,
'tak nie byłoby prościej ?
Layout.Name = "ark " & Counter
Counter = Counter + 1
'...
End If
Next Layout
'tutaj dalej Twój kod
'...
'...
Exit Sub
koniec:
MsgBox "Wystąpił błąd", vbCritical
End Sub
Pozdrawiam
PS.
1. Mógłbyś ująć swój kod w znaczniki kod.vba, bo się ciężko czyta, a tak będzie ładnie sformatowany?
2. Obejrzyj makro Admina z działu makra/AutoCad batchDWG.zip - może Ci się przyda.
Edycja:
Ach jeszcze jedno - jakoś wczoraj przeoczyłem :
With Layout
If .Name <> "Model" Then
.StandardScale = acScaleToFit
'wybor drukarki
.ConfigName = "Default Windows System Printer.pc3"
'rodzaj papieru papieru
.CanonicalMediaName = "A4"
'drukuj zakres
.PlotType = acExtents
'orientacja
.PlotRotation = ac0degrees
'czy wyswietlac style wydruku
.PlotWithPlotStyles = False
'czy wyswietlac style wydruku
'zmiana Tablicy wydruku
.StyleSheet = "monochrome.ctb"
'...
End if
End With
'...
'... |
|
|
napisał: abo
postów: 13
umieszczony:
31 stycznia 2007
21:06
edytowany:
1 lutego 2007
21:16
|
|
Tutaj moje wypociny JAK ustawić arkusze i wydrukować w autocadzie za pomocą makra.
Sub Moje_Drukowanie_v2()
Dim objPlot As AcadPlot
Dim objLayouts() As String
Dim strPlotLocation As String
Dim Counter As Integer
Counter = 1
Dim Layout As ACADLayout
Set objPlot = ThisDrawing.Plot
' katalog przeznaczenia plików przy "drukowaniu do pliku"
strPlotLocation = "c:\download\"
For Each Layout In ThisDrawing.Layouts
'pomin arkusz MODELU
If Layout.Name = "Model" Then GoTo PrzedNEXT
'Ustawienie podziałki drukowania
Layout.StandardScale = acScaleToFit
'wybor drukarki
'Layout.ConfigName = "PublishToWeb JPG.pc3"
Layout.ConfigName = "Default Windows System Printer.pc3"
'rodzaj papieru papieru
Layout.CanonicalMediaName = "A4"
'Layout.CanonicalMediaName = "A5"
'drukuj zakres
Layout.PlotType = acExtents
'orientacja
Layout.PlotRotation = ac0degrees
'czy wyswietlac style wydruku
Layout.PlotWithPlotStyles = False
'czy wyswietlac style wydruku
'Layout.TabOrder = "monochrome.ctb"
'zmiana Tablicy wydruku
Layout.StyleSheet = "monochrome.ctb"
'Layout.StyleSheet = "grayscale.ctb"
'drukowanie z ukrywaniem
'Layout.PlotHidden = false 'Not (Layouts("Layout1").PlotHidden)
'Centrowanie wydruku
Layout.CenterPlot = True
'NumerArkusza = Layout + 1
'ThisDrawing.Layouts.Item(Counter).Name = "Ark" & NumerArkusza
Counter = Counter + 1
ReDim Preserve objLayouts(Counter)
objLayouts(Counter) = Layout.Name
'ThisDrawing.Layouts.
PrzedNEXT:
Next Layout
'regeneracja
ThisDrawing.Regen acAllViewports
objPlot.SetLayoutsToPlot (objLayouts)
'drukowanie do pliku
'objPlot.PlotToFile (strPlotLocation)
'drukowanie do JPEG'a
objPlot.PlotToDevice ("PublishToWeb JPG.pc3")
'objPlot.PlotToDevice ("Default Windows System Printer.pc3")
End Sub
Proszę o poprawki i uwagi jak ktoś ma ochotę
Jeżeli ktoś chce to mogę jeszcze dać program do ustawienia arkuszy
aby drukowały się w kolejności jak je ustawiono |
|
|
napisał: abo
postów: 13
umieszczony:
31 stycznia 2007
20:00
|
|
Używam F1 używam ale czasami to pod
latarnią jest najciemniej
eh... |
|
|
napisał: pil
postów: 154
umieszczony:
31 stycznia 2007
19:22
edytowany:
31 stycznia 2007
19:22
|
|
@Abo : z tą wielkością, toś krzynkę przesadził. Raczej średnio mały. Jeszcze długa, kręta i wyboista droga przede mną. Ale ...
choćbym szedł doliną ciemną,
zła się nie ulęknę,
albowiem mam F1 tuż pod ręką.
A to, co pod F1 w Acadzie siedzi jest naprawdę potężnym źródłem wiedzy.
@Artik: wiem, że zaśmiecam wątek .... ale śpisz czasami? |
|
|
napisał: abo
postów: 13
umieszczony:
31 stycznia 2007
18:18
|
|
Oczywiście że o to
jesteś WIELKI !! |
|
|
napisał:  admin
postów: 613
umieszczony:
30 stycznia 2007
23:03
|
|
Admin też... kiedyś... Nawet napisałem program do masowego wydruku rysunków... ale już w zasadzie zapomniałem jak wygląda VBA dla AutoCADa.
A o co chodzi?
Cytat:czy ktoś z was pisze makra pod Autocada ?
cokolwiek... |
|
|
napisał: pil
postów: 154
umieszczony:
30 stycznia 2007
23:03
|
|
@Artik - jestem, jestem, tylko przysypiam trochę :)
Sub ZmienTabliceStylow()
Dim Layout as AcadLayout
'żeby zmienić styl na pojedynczym arkuszu:
Set Layout = ThisDrawing.Layouts(0)
Layout.StyleSheet = "monochrome.ctb"
'i kompleksowo - we wszystkich :
For Each Layout in ThisDrawing.Layouts
Layout.StyleSheet = "monochrome.ctb"
Next Layout
End Sub
O to chodziło ? |
|
|
napisał: abo
postów: 13
umieszczony:
30 stycznia 2007
20:11
|
|
czy ktoś z was pisze makra pod Autocada ?
cokolwiek... |
|
|
napisał: abo
postów: 13
umieszczony:
29 stycznia 2007
18:28
|
|
Czy ktoś napisał może makro na ustawienie wszystkich opcji wydruku.
Normalnie ustawia się je przez menadżera wydruku :
drukarka, rodzaj papieru, centrowanie itd.....?
mam prawie wszystko a utknąłem na ustawieniu tablicy stylów wydruku ctb |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
|
