Clean up code Multisheet PDF lisp

Clean up code Multisheet PDF lisp

Anonymous
Not applicable
3,919 Views
22 Replies
Message 1 of 23

Clean up code Multisheet PDF lisp

Anonymous
Not applicable

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

 

 

0 Likes
Accepted solutions (2)
3,920 Views
22 Replies
Replies (22)
Message 21 of 23

cadffm
Consultant
Consultant

(wcmatch (strcat (vla-get-name l)) (strcat "*COLOR*"))

 

I think you want to wrote

 

(wcmatch (strcase (vla-get-name l)) (strcase "*COLOR*"))

 or short

(wcmatch (strcase (vla-get-name l)) "*COLOR*")

 

[F1] STRCAT vs. STRCASE

Sebastian

Message 22 of 23

ronjonp
Mentor
Mentor

@cadffm Nice eye! No wonder the OP was having issues 🍻

 

That's the ticket:

 

(wcmatch (strcase (vla-get-name l)) "*COLOR*")

 

 

Here's the revised code from the second post in this thread since I cannot make the change there. 🙃

(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)) 2)
      (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 (strcase (vla-get-name l)) "*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)
)
0 Likes
Message 23 of 23

Anonymous
Not applicable

@ronjonp @cadffm @_Tharwat 

Thank you for all your help, below is what is what I settled with.  I could not figure out why but if I removed the tabs(layouts) that were empty first the all tabs named higher in the alphabet than Model would not process (update the layout settings).   Once I moved the layout remove portion to the end right before the export it worked no mater the layout names and only COLOR is in color.   

Again thank you for all your help.

(defun c:pdf2 (/ ad)
  (vl-load-com)

 (setq ad (vla-get-activedocument (vlax-get-acad-object)))

  
  (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 (strcase (vla-get-name l)) "*COLOR*")
				"acad.ctb"
				"monochrome.ctb"
			)
	    )				;set to acad
	    (vla-put-plottype l 1)	;plot area extents
	    (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
	    (vla-put-standardscale l acscaletofit) ;Fit to paper
      )	;progn
    )
  )
  ;; This only regens the current tab you're on?
  (vla-regen ad acallviewports)

;; Delete empty layouts
(vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
  (and (= 0 (vla-get-count (vla-get-block lay))) (vl-catch-all-apply 'vla-delete (list lay)))
) 

;export PDF
(command "_.-export" "_PDF" "_A"
	   (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)))
)
  (prompt "\nComplete...")
  (princ)
);EOP

 

0 Likes