Clean up code Multisheet PDF lisp

[Anonymous]

So with the help of this forum and lots of searching and many failures, this works like it should.

If you have several layout tabs this will delete any layout that is empty and make one PDF with all the layouts, if a layout is named COLOR (must be caps) only this page will be in color all others will be black and white.

Attached is a screen shot of layout tabs and the resulting PDF.

Could the code be made more simple? Or cleaned up a little?

Thanks for any advice.

(defun c:pdf2 ( /)

(vl-load-com)



; removes any empty sheets
	(vlax-for objLayout (setq colLayouts (vla-get-layouts(vla-get-activedocument(vlax-get-acad-object))))
		(if (and (< (vla-get-count (vla-get-block objLayout)) 2) (> (vla-get-count colLayouts) 2))
			(if (/= (vla-get-name objLayout) "Model")
			(vla-delete objLayout)
			);if
		); if
	);vlax-for end

;check each layout named COLOR run color program
(foreach l (layoutlist)
  (if (wcmatch (strcase l) (strcat "*COLOR*"))
(clrpdf)
  );if
);foreach

;Check each layout is not named COLOR run monochrome program
(foreach l (layoutlist)
(if (not (wcmatch (strcase l) (strcat "*COLOR*")))
(bwpdf)
  );if
)

;refresh all the sheets before export to set proper scale
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)

;sets PDF name to SHEET	
; Gets drawing base name
(setq dwgnms (vl-filename-base (getvar 'dwgname)))
(setq prefs (getvar 'dwgprefix))

; exports PDF as batchplot-model.pdf
(command "_.-export" "_PDF" "_A" (strcat prefs dwgnms))

(prompt "\nComplete...")
(princ)
);defun


**********************************************

;program for color layout set up
(defun clrpdf ()
(setvar "CTAB" l)

;cycle all sheets, skip model
(vlax-for lay (vla-get-layouts (vla-get-ActiveDocument (vlax-get-acad-object)))


	;if not model sheet
	(if (/= "Model" (vla-get-name lay))

		(if (wcmatch (strcat (vla-get-name lay)) (strcat "*COLOR*"))
		    (progn
			(vla-put-ConfigName lay "None") ; set ploter name to none
			(vla-put-CanonicalMediaName lay "ANSI_E_(34.00_x_44.00_Inches)") ;Paper ANSI E
			(vla-put-PlotRotation lay 1) ;landscape
			(vla-put-stylesheet lay "acad.ctb") ;set to acad
			(vla-put-plottype lay 1) ;plot area extents
			(vla-put-CenterPlot lay T) ;center plot
			(vla-put-UseStandardScale lay T) ;use standard scale 
			(vla-put-PlotViewportsFirst lay T) ;plot viewports first check
			(vla-put-PlotWithPlotStyles lay T) ;plot with styles check
			(vla-put-PlotWithLineweights lay T) ;Check Lineweights
			(vla-put-StandardScale lay acScaleToFit) ;Fit to paper
		    );progn
		);if color
	);if model
);vlax

);defun end

**********************************************

;program for monochrome layout set up
(defun bwpdf ()

;cycle all sheets, skip model
(vlax-for lay (vla-get-layouts (vla-get-ActiveDocument (vlax-get-acad-object)))

	;if not model sheet
	(if (/= "Model" (vla-get-name lay))

		(if (not (wcmatch (strcat (vla-get-name lay)) (strcat "*COLOR*")))
		    (progn
			(vla-put-ConfigName lay "None") ; set ploter name to none
			(vla-put-CanonicalMediaName lay "ANSI_E_(34.00_x_44.00_Inches)") ;Paper ANSI E
			(vla-put-PlotRotation lay 1) ;landscape
			(vla-put-stylesheet lay "monochrome.ctb") ;set to monochrome
			(vla-put-plottype lay 1) ;plot area extents
			(vla-put-CenterPlot lay T) ;center plot
			(vla-put-UseStandardScale lay T) ;use standard scale 
			(vla-put-PlotViewportsFirst lay T) ;plot viewports first check
			(vla-put-PlotWithPlotStyles lay T) ;plot with styles check
			(vla-put-PlotWithLineweights lay T) ;Check Lineweights
			(vla-put-StandardScale lay acScaleToFit) ;Fit to paper
		    );progn
		);if color
	);if model
);vlax

);defun end

[ronjonp · Accepted solution]

Untested but give this a try:

(defun c:pdf2 (/ ad)
  (vl-load-com)
  ;; Delete empty layouts
  (vlax-for l (vla-get-layouts (setq ad (vla-get-activedocument (vlax-get-acad-object))))
    (if	(= (vla-get-count (vla-get-block l)) 1)
      (vl-catch-all-apply 'vla-delete l)
    )
  )
  (vlax-for l (vla-get-layouts ad)
    (if	(= 0 (vlax-get l 'modeltype))
      (progn (vla-put-configname l "None") ; set plotter name to none
	     (vla-put-canonicalmedianame l "ANSI_E_(34.00_x_44.00_Inches)") ;Paper ANSI E
	     (vla-put-plotrotation l 1)	;landscape
	     (vla-put-stylesheet
	       l
	       (if (wcmatch (strcat (vla-get-name l)) (strcat "*COLOR*"))
		 "acad.ctb"
		 "monochrome.ctb"
	       )
	     )				;set to acad
	     (vla-put-plottype l 1)	;plot area extents
	     (vla-put-centerplot l t)	;center plot
	     (vla-put-usestandardscale l t) ;use standard scale 
	     (vla-put-plotviewportsfirst l t) ;plot viewports first check
	     (vla-put-plotwithplotstyles l t) ;plot with styles check
	     (vla-put-plotwithlineweights l t) ;Check Lineweights
	     (vla-put-standardscale l acscaletofit) ;Fit to paper
      )					;progn
    )
  )
  ;; This only regens the current tab you're on?
  (vla-regen ad acallviewports)
  (command "_.-export"
	   "_PDF"
	   "_A"
	   (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)))
  )
  (prompt "\nComplete...")
  (princ)
)

[Sea-Haven]

A couple of suggestions plot range option, save pdfs in a directory under dwg directory use ghostscript to join the individual pdf's back to one.

; check that pdf directory exists
(setq dwgpre (strcat (getvar "dwgprefix") "\pdf"))
(if (= (vl-file-directory-p dwgpre) nil)
(vl-mkdir dwgpre)
)

 

[Anonymous]

ronjonp

Your code is much simpler and will be easier to incorporate in the larger code.  Thank you.

The one issue was that the empty layouts would not delete. 

I could not get this to work

  ;; Delete empty layouts
  (vlax-for l (vla-get-layouts (setq ad (vla-get-activedocument (vlax-get-acad-object))))
    (if	(= (vla-get-count (vla-get-block l)) 1)
      (vl-catch-all-apply 'vla-delete l)
    )
  )

 This is probably way wrong but for the program to work like my original I had to do this to the first part of the code. And change the above to just set the values.

; removes any empty sheets
	(vlax-for objLayout (setq colLayouts (vla-get-layouts(vla-get-activedocument(vlax-get-acad-object))))
		(if (and (< (vla-get-count (vla-get-block objLayout)) 2) (> (vla-get-count colLayouts) 2))
			(if (/= (vla-get-name objLayout) "Model")
			(vla-delete objLayout)
			);if
		); if
	);vlax-for end


  ;; set for l and ad
  (vlax-for l (vla-get-layouts (setq ad (vla-get-activedocument (vlax-get-acad-object)))))

[_Tharwat]

I guess @ronjonp assumed that the empty layout has a viewport and that's why he counted for one object in the layout, so just rectify the following and it should work as demonstrated into your original codes.

(if (< (vla-get-count (vla-get-block l)) 2)
  (vl-catch-all-apply 'vla-delete l)
 )

[Anonymous]

Tharwat

My drawing has a few layouts with items (rectangle and lines) and a few layouts that are empty.  I'm using AutoCAD Mechanical 2019 if that matters.

When I copy this below and paste in the command line nothing happens. 

(vlax-for l (vla-get-layouts (setq ad (vla-get-activedocument (vlax-get-acad-object))))
(if (< (vla-get-count (vla-get-block l)) 2)
(vl-catch-all-apply 'vla-delete l)
)
)

When I copy the first part of my original code and paste in the command line all layouts that are empty are removed.

(vlax-for objLayout (setq colLayouts (vla-get-layouts(vla-get-activedocument(vlax-get-acad-object))))
(if (and (< (vla-get-count (vla-get-block objLayout)) 2) (> (vla-get-count colLayouts) 2))
(if (/= (vla-get-name objLayout) "Model")
(vla-delete objLayout)
)
)
)

I'm sorry I'm not real familiar with what is going on to modify what you have to make it work like mine.

Attached are the before and after screen shot of the tabs.  The tabs with no vport, lines or anything are removed. 

Thanks

[_Tharwat · Accepted solution]

Try this one instead.

(vlax-for l (vla-get-layouts
              (setq ad (vla-get-activedocument (vlax-get-acad-object)))
            )
  (and (/= "Model" (vla-get-name l))
       (zerop (vla-get-count (vla-get-block l)))
       (vl-catch-all-apply 'vla-delete (list l))
  )
)

[Sea-Haven]

Is the (setq ad really needed, or is it used else where ? 

[_Tharwat]

---

@Sea-Haven wrote:

Is the (setq ad really needed, or is it used else where ? 

---

Are you serious?

You are contributing in every thread all over AutoLISP forums on this planet and have thousands of posts and still asking such a bity question ! 

I am not a copy and paste guy like many over there.

[Anonymous]

Tharwat, 

The last mod to the code work perfect.  Thank you.  

Don't sweat the last question they would have known it was part of the last code that ronjonp posted if they would have just looked.

Thanks again to to ronjonp and Tharwat for your help it is much appreciated. 

[ronjonp]

@_Tharwat Thanks for picking this up 🍻 .. been on break :). Since we're using a sledgehammer approach we probably don't need to check if it's paperspace.

(vlax-for l (vla-get-layouts (setq ad (vla-get-activedocument (vlax-get-acad-object))))
  (and (= 0 (vla-get-count (vla-get-block l))) (vl-catch-all-apply 'vla-delete (list l)))
)

[CadDog02]

AutoCAD has this tool already. DWG-PURGE. You can download it here: 

https://apps.autodesk.com/en/Detail/Index?id=3773138176974634673&appLang=en&os=Win32_64

Once installed on your Ribbon under Add-Ins...

It can do current open drawing or batch purge.

[Anonymous]

So I found out that this needs to be in a If statement and when I do that it doesn't cycle thru the sheets correctly to change all the layouts. any ideas

 (if (= 0 (vlax-get l 'modeltype))
(progn 

--ronjonp cleaned up code

);progn end

);if end

[ronjonp]

---

@Anonymous wrote:

So I found out that this needs to be in a If statement and when I do that it doesn't cycle thru the sheets correctly to change all the layouts. any ideas

 (if (= 0 (vlax-get l 'modeltype))
(progn 

--ronjonp cleaned up code

);progn end

);if end

---

That line just ensures we're not processing the model tab ? 

Closer look and rather than using 'T' you should use :vlax-true for these lines.

	     (vla-put-centerplot l :vlax-true)	;center plot
	     (vla-put-usestandardscale l :vlax-true) ;use standard scale 
	     (vla-put-plotviewportsfirst l :vlax-true) ;plot viewports first check
	     (vla-put-plotwithplotstyles l :vlax-true) ;plot with styles check
	     (vla-put-plotwithlineweights l :vlax-true) ;Check Lineweights

[CadDog02]

Sorry ronjonp, but I misread your post. Read that you wanted to purge sheets (dwg-purge) not remove unused paper space taps. I hope you find what you need. I don't have a clue on how to beginning to remove these taps. Our company follows the CAD standards states. One drawing one paper space tab. All our templates have one PS tab and we teach all our users to follow this standard. I'm not saying this is a bad thing or a poor method of creating sheets, I'm just saying we don't have this problem. I know this will be worked out for you soon. There're a lot of great code writers here and hopefully, one will find this post and help you out soon. Take care.

[Anonymous]

I understand that but the code doesn’t work the same.

I have two programs that are identical except for the if statement and the one without works correctly and the one with it does not correctly.  Not at my pc right now but will attach later.

[Anonymous]

ronjonp,

Please help me understand this. 

(vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-name layout))

If my tabs are default Model, Layout1, Layout2, Layout3 and I paste the code on the command line the return is Model.

If my tabs are modified Model, Layout1, SHEET-2, Layout3 and I paste the code on the command line the return is SHEET-2.

If my tabs are modified Model, Layout1, COLOR-2, Layout3 and I paste the code on the command line the return is Model.

I think this is the issue I am having. It seems that Sheet or SHEET is causing the return of SHEET instead of Model.

Why is this happening?

[ronjonp]

That will only show one result .. if you want to see the names of all the tabs then try something like this:

(vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
  (print (vla-get-name layout))
)

The logic used was any layout tab that has *COLOR* in the name gets assigned acad.ctb anything else ( other than modelspace ) gets monochrome.ctb. Isn't that what you wanted?

[Anonymous]

Yes that is what I wanted and it works flawlessly with default layout names and "COLOR" layout.  But for some reason if the layout name is SHEET or Sheet then I have issues.

OK attached are the drawings tested and nest are the results when the program is ran

Default_Layout.dwg - All layouts are Monochrome as expected. 

Color_Layout.dwg - Layouts named COLOR are in color and others are monochrome

Sheet_Layout.dwg - Layouts named SHEET are in color but not sized correctly and others are Monochrome, I've tried other tab names and get the same result. 

It looks like tabs Layout1, layout2, etc are ok but anything else and there is an issue. 

PDF10.lps - your code from above with mods you and Tharwat suggested.  Next Post

[Anonymous]

PDF10.lps - your code from above with mods you and Tharwat suggested.