;;; VPLMAKE
;;; Makes the layer TPZ-Vport and places all PS viewports on it even frozen
;;; Copyright 2005 Lance Gordon Custom Software
;;; Modified by Igal Averbuh 2016 (added unloading and reloading of all xrefs and images bebore and after main process)

;;; LISP to unload all XREF's,and IMAGE's

(defun c:ua (/)
(vl-load-com)
(vl-cmdf "_.-xref" "u" "*")
(vl-cmdf "_.-image" "u" "*")
(princ)
)

;;; LISP to reload all XREF's,and IMAGE's

(defun c:ra (/)
(vl-load-com)
(setvar "visretain" 1)
(vl-cmdf "_.-xref" "r" "*")
(vl-cmdf "_.-image" "r" "*")
(princ)
)

(defun c:vpm1 (/ tm filter ss ssctr mctr)
(setvar "CMDECHO" 0)
; (command "_UNDO" "BEgin")
(if (not (tblsearch "LAYER" "TPZ-Vport"))
(command "._-layer" "New" "TPZ-Vport" "C" "1" "TPZ-Vport" "" )
(command "._-layer" "ON" "TPZ-Vport" "T" "TPZ-Vport" "")
)
(setq tm (getvar "TILEMODE"))
(setq filter (list '(-4 . "<AND")
'(0
.
"VIEWPORT"
)

'(-4 . "")
'(-4 . "AND>")
)
) ; exclude model vport
(if (setq ss (ssget "X" filter))
(progn ; retrieve layout names
(setq llist (layout-list ss))
(if (= tm 1)
(setvar "TILEMODE" 0)
) ; and walk through layouts.
(setq mctr 0) ; count changed VPs
(foreach layout llist
(setvar "CTAB" layout)
(if (/= (getvar "CVPORT") 1)
(command "PSPACE")
) ; be sure we can get at the ports
(setq ssctr 0)
(while ( mctr 0)
(princ
(strcat (itoa mctr) " viewport(s) placed on layer TPZ-Vport.")
)
) ; Warn that TPZ-Vport is turned on before exiting
(princ "NOTE: Layer \"TPZ-Vport\" is turned ON.")
; (command "_UNDO" "End")
(setvar "CMDECHO" 1)
(princ)
)
;;; LAYOUT-LIST creates a list of Layout names
;;; where viewports are found. The selection set
;;; passed with this routine is NOT altered or destroyed.
(defun layout-list (vps / vp el ctr)
(if (> (atoi (getvar "ACADVER")) 14) ; Check for R14 (one layout)
(progn
(setq ctr 0)
(while (< ctr (sslength vps))
(setq vp (ssname vps ctr))
(setq el (entget vp))
(if (/= (cdr (assoc 69 el)) 1) ; Look for Layout names of VPs
(if lllist ; and put them in a list
(if (not (member (cdr (assoc 410 el)) lllist))
(setq lllist (append lllist (list (cdr (assoc 410 el)))))
) ; Append only if not already in the list
(setq lllist (list (cdr (assoc 410 el))))
)
)
(setq ctr (1+ ctr))
)
)
(progn ; If this is R14,
(setq vp (ssname vps 0))
(while (not (null vp)) ; walk through VP list,
(ssdel vp vps)
(setq el (entget vp))
(if (/= (cdr (assoc 69 el)) 1) ; look for PSPACE TPZ-Vport,
(setq lllist "Layout")
) ; and note if found.
(setq vp (ssname vps 0))
)
)
)
lllist ; Send layout list back to calling routine
)
(princ "\nVPLMAKE loaded. Type VPM to invoke (C)LGCS 2005\n")
(princ)

(defun c:vpm()
(c:ua)
(c:vpm1)
(c:ra)
(princ)
)

Advertisements