(defun c:igalvp (/ vpl vplyes l0 ln layers cp cl cs ofs vpc1 vpc2 vpxd vpyd vpc svpc ssvp ssvp1 sf lpno vpno ssnum vpent nvpc1 nvpc2 nvpc1x nvpc1y nvpc2x nvpc2y)
; Creates layout of Paper Space viewports of specified 2D orthagonal views from Model Space
; Used when all 2D design is done in Model Space at full scale and all dimensioning is done in Paper Space as associated scale
; Start command from destination layout tab
; Program will switch to Model Space for selection of desired objects
; Program will return to layout tab for creation of viewport frames
; First a single viewport is made that includes all relevant views of desired part at the desired zoom level
; The single viewport is copied over itself the number of desired separate views
; Then the overlaying viewports are individually clipped to the edges of the separate views
; The separate views will maintain their original orientation and alignment
; The separate views can be rectangular by specifying opposite corners or circular by specifying a center and radius
; Afterwards move the individual views orthogonally, if needed, to allow space for dimensions
(setvar "cmdecho" 0) ; Turn off command line echoing
(setvar "tilemode" 0)
(setq cp (getvar "ctab")) ; Store current tab name
(setq cl (getvar "clayer")) ; Store current layer name
(setq cs (getvar "osmode")) ; Store current osnap mode
(setq vpl "TPZ-VPort") ; ==>> Assume using Viewport layer for viewport frames, change code value here if needed <> Set viewport border offset from actual detail, change code value here if needed <<==
(setvar "osmode" 0) ; Turn osnap on
(if (/= cp "Model") ; Must be started from a layout tab to establish destination, quit quietly if on Model tab
(progn
(princ "\n") ; Clean up command line
(setq vplyes 0) ; Assume viewport doesn't exist
(setq l0 (tblnext "LAYER" 1)) ; Get past 0 layer in layer list
(while (setq layers (tblnext "LAYER")) ; Loop through layer list collection
(setq ln (cdr (assoc 2 layers))) ; Extract layer name from list
(if (= (strcase ln) (strcase vpl)) (setq vplyes 1)) ; Check if viewport layer exists
)
(if (= vplyes 0) (command "layer" "NEW" vpl "COLOR" "7" vpl "")) ; Make viewport layer and assign color to magenta if doesn't exist
(setvar "clayer" vpl) ; Change to viewport layer
(command "layer" "ON" (strcat "0," vpl) "UNLOCK" (strcat "0," vpl) "") ; Turn on and unlock viewport and 0 layer
(command "zoom" "e") ; View entire layout tab
(setvar "ctab" "Model") ; Activate Model tab
(command "zoom" "e") ; View entire Model Space area
(setq vpc1 (getpoint "\nSpecify first corner of model space window area: ")) ; Just pick rough area including all relavent details, will fine-tune border area later in Paper Space
(if vpc1 ; Quietly quit if no point specified
(progn
(setq vpc2 (getcorner vpc1 "\nSpecify opposite corner of model space window area: ")) ; Window rectangle can be designated in any direction
(if vpc2 ; Quietly quit if no point specified
(progn
(princ "\n") ; Clean up command line
(setvar "ctab" cp) ; Return to layout tab program was started from
(command "pspace") ; Switch to Paper Space of layout tab
(setq svpc (getpoint "\nSpecify destination of paper space viewport center: ")) ; Can't change layout tabs manually here
(if svpc ; Quietly quit if no point specified
(progn
(setq sf (getreal "\nViewport zoom scale factor : ")) ; Default to full-scale if no value is inputted
(if (= sf nil) (setq sf 1.0) (setq sf (abs sf))) ; Make sure scale factor is positive number
(setq vpxd (* sf (abs (- (car vpc2) (car vpc1))))) ; Determine horizontal length of selected window
(setq vpyd (* sf (abs (- (cadr vpc2) (cadr vpc1))))) ; Determine vertical height of selected window
(setq vpc (list (/ (+ (car vpc1) (car vpc2)) 2.0) (/ (+ (cadr vpc1) (cadr vpc2)) 2.0) 0.0)) ; Determine center point of selected model window
(command "mview" (list (- (car svpc) (/ vpxd 2.0)) (- (cadr svpc) (/ vpyd 2.0))) (strcat "@" (rtos vpxd) "," (rtos vpyd))) ; Create Paper Space viewport
(setq ssvp (ssget "L")) ; Start selection set with last viewport frame
(setq ssvp1 (ssget "L")) ; Another copy of viewport frame selection set
(command "mspace") ; Open viewport window to Model Space
(command "ucsicon" "ON") ; Turn on UCS icon for viewport
(command "ucs" "WORLD") ; Reset UCS to WCS
(command "zoom" "C" vpc (rtos vpyd)) ; Center view of viewport window using determined point
(command "zoom" "SCALE" (strcat (rtos sf) "XP")) ; Set zoom scale of viewport window
(command "vports" "LOCK" "ON" ssvp "") ; Lock scale and position of model in viewport
(command "pspace") ; Close viewport window
(command "zoom" (list (- (car svpc) (/ vpxd 2.0)) (- (cadr svpc) (/ vpyd 2.0))) (strcat "@" (rtos vpxd) "," (rtos vpyd))) ; Zoom in on just created viewport extremes
(command "zoom" "0.95X") ; Back zoom off slightly to see edges clearly
(setq lpno 2) ; Loop counter for making separate viewports
(setq vpno (getint "\nNumber of separate viewports to make from this viewport : ")) ; Will divide single viewport into separate viewports for othagonal views of 2D part
(if (>= vpno 2) ; Proceed to copy current viewport if 2 or more separate viewports desired
(progn
(while (<= lpno vpno) ; Check if viewport loop counter less than number of viewports desired
(command "copy" ssvp "" "0,0" "@0,0") ; Make copy of new viewport laying exactly on top of first viewport
(setq lpno (1+ lpno)) ; Increment viewport loop counter
(ssadd (entlast) ssvp1) ; Add viewport copy to selection set
)
)
)
(setq ssnum 0) ; Loop counter for fine-tuning separate viewports
(while (= vpno 2) ; Check for multiple viewports
(setq clt (strcat " #" (rtos (+ ssnum 1) 2 0))) ; Make command prompt string if using multiple viewports
(setq clt "") ; Make command prompt string if using single viewport
)
(initget 128) ; Enable string responses from point prompt
(setq nvpc1 (getpoint (strcat "\nSpecify first corner of viewport" clt " window area or [Center point of circle]: "))) ; Pick actual part corner, program will apply offset
(if nvpc1 ; Will repeat asking for first corner if none specified
(progn
(if (= 'STR (type nvpc1)) ; Check if string was inputted instead of corner point
(progn
(if (= "C" (strcase (substr nvpc1 1 1))) ; Check if asking for circular viewport area
(progn
(setq nvpc1 (getpoint (strcat "\nSpecify center of viewport" clt " window area: "))) ; Pick center of separate circular viewport window
(if nvpc1 ; Will return to asking for first corner if center not specified
(progn
(setvar "osmode" 0) ; Turn osnap off
(princ (strcat "\nSpecify radius of viewport" clt " window area: ")) ; Make command prompt for circle viewport
(command "circle" nvpc1 pause) ; Make circle to clip existing viewport
(setvar "osmode" 2559) ; Turn osnap on
(setq ssvp (ssget "L")) ; Select last circle
(command "vpclip" vpent ssvp) ; Clip existing viewport to circle
(setq ssnum (1+ ssnum)) ; Increment fine-tuned viewport loop counter
)
)
)
)
)
(progn
(setq nvpc2 (getcorner nvpc1 (strcat "\nSpecify opposite corner of viewport" clt " window area: "))) ; Window rectangle can be designated in any direction, pick actual part corner, program will apply offset
(if nvpc2 ; Will repeat asking for first corner if none specified
(progn
(setq nvpc1x (car nvpc1)) ; Find X portion of first corner
(setq nvpc1y (cadr nvpc1)) ; Find Y portion of first corner
(setq nvpc2x (car nvpc2)) ; Find X portion of second corner
(setq nvpc2y (cadr nvpc2)) ; Find Y portion of second corner
(if (> nvpc2x nvpc1x) ; Determine horizontal direction of viewport window rectangle
(progn
(setq nvpc2x (+ nvpc2x ofs)) ; Add horizontal offset to right of specified left-to-right window rectangle
(setq nvpc1x (- nvpc1x ofs)) ; Add horizontal offset to left of specified left-to-right window rectangle
)
(progn
(setq nvpc2x (- nvpc2x ofs)) ; Add horizontal offset to left of specified right-to-left window rectangle
(setq nvpc1x (+ nvpc1x ofs)) ; Add horizontal offset to right of specified right-to-left window rectangle
)
)
(if (> nvpc2y nvpc1y) ; Determine vertical direction of viewport window rectangle
(progn
(setq nvpc2y (+ nvpc2y ofs)) ; Add vertical offset to top of specified lower-to-upper window rectangle
(setq nvpc1y (- nvpc1y ofs)) ; Add vertical offset to bottom of specified lower-to-upper window rectangle
)
(progn
(setq nvpc2y (- nvpc2y ofs)) ; Add vertical offset to bottom of specified upper-to-lower window rectangle
(setq nvpc1y (+ nvpc1y ofs)) ; Add vertical offset to top of specified upper-to-lower window rectangle
)
)
(setvar "osmode" 0) ; Turn osnap off
(command "rectang" (list nvpc1x nvpc1y) (list nvpc2x nvpc2y)) ; Make rectangle with offset to clip existing viewport
(setvar "osmode" 2559) ; Turn osnap on
(setq ssvp (ssget "L")) ; Select last rectange
(command "vpclip" vpent ssvp) ; Clip existing viewport to rectangle
(setq ssnum (1+ ssnum)) ; Increment fine-tuned viewport loop counter
)
)
)
)
)
)
)
)
)
)
)
)
)
)
(princ "\nThis command must be started from a layout sheet!") ; Need to start on a layout tab so program knows where to create the new viewports
)
(setvar "ctab" cp) ; Reset to stored tab name
(setvar "clayer" cl) ; Reset to stored layer name
(setvar "osmode" cs) ; Reset to stored osnap mode
(setvar "cmdecho" 1) ; Turn on command line echoing
(princ) ; Clean up and exit
)

Advertisements