;;;Generate list of user specified Vport #'s with Acad #'s associated ;;;Layer name must contain "VI##" where ## is a two digit user specified ;;;view number. ;;; ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe Street ;;; Southern Pines, NC 28387 ;;; ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; Edited: 4-9-2010 Corrected error where non-existent user viewport number ;;; would cause an infinite loop. ;;; Edited: 1-9-2012 Corrected error caused by selecting viewports on multiple layout tabs ;;; (DEFUN vpset-error (msg / ) (SETQ vpedatlst NIL vpedat NIL vpdatlst NIL) (SETQ *ERROR* old-vpset-error) (PRINC "\nVPSET ERROR: ") (PRINC msg) (PRINC) ) (DEFUN c:vpset (/ curvno vportss vpsslen cnt vpdat uvport vpfini) (SETQ old-vpset-error *ERROR*) (SETQ *ERROR* vpset-error) (SETQ curvno (GETVAR "cvport")) (SETQ vportss (SSGET "x" (LIST (CONS 0 "VIEWPORT")(CONS 410 (GETVAR "CTAB"))))) (SETQ vpsslen (SSLENGTH vportss)) (SETQ cnt 0) (SETQ vpedatlst nil) (WHILE (< cnt vpsslen) (SETQ vpedat (ENTGET (SSNAME vportss cnt))) (IF (/= (CDR (ASSOC 8 vpedat)) "0") (IF vpedatlst (SETQ vpedatlst (APPEND vpedatlst (LIST vpedat))) (SETQ vpedatlst (LIST vpedat)) ) ;_ end of if ) ;_ end of if (SETQ cnt (1+ cnt)) ) ;_ end of while (SETQ floatvp_isactive NIL) (FOREACH n vpedatlst (IF (>(cdr(assoc 68 n))0) (SETQ floatvp_isactive T))) (IF (AND (> vpsslen 1) floatvp_isactive) (PROGN (IF (AND (= curvno 1) (EQ (GETVAR "tilemode") 0)) (vla-put-MSpace (vla-get-Activedocument (vlax-get-Acad-Object)) :vlax-true) ;;; (COMMAND ".mspace") ) ;_ end of if (SETQ cnt 0) (SETQ vpdatlst nil) (WHILE (< cnt vpsslen) (SETQ vpdat (ENTGET (SSNAME vportss cnt))) (IF (/= (CDR (ASSOC 8 vpdat)) "0") (IF vpdatlst (SETQ vpdatlst (APPEND (LIST (CONS (READ (SUBSTR (CDR (ASSOC 8 vpdat)) 5 2)) (CDR (ASSOC 69 vpdat)))) vpdatlst)) (SETQ vpdatlst (LIST (CONS (READ (SUBSTR (CDR (ASSOC 8 vpdat)) 5 2)) (CDR (ASSOC 69 vpdat))))) ) ;_ end of if ) ;_ end of if (SETQ cnt (1+ cnt)) ) ;_ end of while (IF uint nil (LOAD "uint" "\nFile UINT.LSP not loaded! ")) (WHILE (NOT vpfini) (SETQ uvport (uint 4 "" "User Viewport Number" (IF uvport uvport 3 ) ;_ end of if ) ;_ end of uint ) ;_ end of setq (IF (ASSOC uvport vpdatlst) (PROGN (SETVAR "cvport" (CDR (ASSOC uvport vpdatlst))) (SETQ vpfini T)) (PRINC (STRCAT "\nUser Viewport Number " (ITOA uvport) " Not Found! ")) ) ;_ end of if ) ;_ end of while ) (PRINC "\nThere are no active Model space viewports. ") ) (SETQ *ERROR* old-vpset-error) (SETQ old-vpset-error NIL) (PRINC) ) ;_ end of defun (DEFUN vpset (uvport / curvno vportss vpsslen cnt vpdat uvport vpfini) (vl-load-com) (SETQ curvno (GETVAR "cvport")) (SETQ vportss (SSGET "x" '((0 . "VIEWPORT")))) (SETQ vpsslen (SSLENGTH vportss)) (SETQ cnt 0) (SETQ vpedatlst nil) (WHILE (< cnt vpsslen) (SETQ vpedat (ENTGET (SSNAME vportss cnt))) (IF (AND (/= (CDR (ASSOC 8 vpedat)) "0")(EQUAL (CDR (ASSOC 410 vpedat)) (GETVAR "ctab"))) (IF vpedatlst (SETQ vpedatlst (APPEND vpedatlst (LIST vpedat))) (SETQ vpedatlst (LIST vpedat)) ) ;_ end of if ) ;_ end of if (SETQ cnt (1+ cnt)) ) ;_ end of while (SETQ floatvp_isactive NIL) (FOREACH n vpedatlst (IF (>(cdr(assoc 68 n))0) (SETQ floatvp_isactive T))) (IF (AND (> vpsslen 1) floatvp_isactive) (PROGN (IF (AND (= curvno 1) (EQ (GETVAR "tilemode") 0)) (vla-put-MSpace (vla-get-Activedocument (vlax-get-Acad-Object)) :vlax-true) ;;; (COMMAND ".mspace") ) (SETQ cnt 0) (SETQ vpdatlst nil) (WHILE (< cnt vpsslen) (SETQ vpdat (ENTGET (SSNAME vportss cnt))) (IF (AND (/= (CDR (ASSOC 8 vpdat)) "0")(EQUAL (CDR (ASSOC 410 vpdat)) (GETVAR "ctab"))) (IF vpdatlst (SETQ vpdatlst (APPEND (LIST (CONS (READ (SUBSTR (CDR (ASSOC 8 vpdat)) 5 2)) (CDR (ASSOC 69 vpdat)))) vpdatlst)) (SETQ vpdatlst (LIST (CONS (READ (SUBSTR (CDR (ASSOC 8 vpdat)) 5 2)) (CDR (ASSOC 69 vpdat))))) ) ;_ end of if ) ;_ end of if (SETQ cnt (1+ cnt)) ) ;_ end of while (FOREACH n vpdatlst (IF (EQ (CAR n) uvport) (PROGN (SETVAR "cvport" (CDR (ASSOC uvport vpdatlst))) (SETQ vpfini T)) ) ) (IF (NOT vpfini) (PRINC (STRCAT "\nUser Viewport Number " (ITOA uvport) " Not Found! ")) ) ;;; (WHILE (NOT vpfini) ;;; (IF (ASSOC uvport vpdatlst) ;;; (PROGN (SETVAR "cvport" (CDR (ASSOC uvport vpdatlst))) (SETQ vpfini T)) ;;; (PRINC (STRCAT "\nUser Viewport Number " (ITOA uvport) " Not Found! ")) ;;; ) ;_ end of if ;;; ) ;_ end of while ) (PRINC "\nThere are no active Model space viewports. ") ) ;_ end of if (PRINC) ) ;_ end of defun ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ***Don't add text below the comment!***|;