Message 1 of 19
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
This lisp is my combination of 2 subroutines first one - can create viewport outline in model space.
Second one use selection set from the first one in order to copy it to model space
;;; VPLIMITS.lsp draws the limits of a Paperspace Viewport Boundary in
;;; Modelspace
;;; Based on VPLIM.lsp written by Murray Clack, February 18, 1999
;;;
;;; Modified by Stephen Bindon for Circlular Viewports
;;;
;;; Modified by Tod Winn to stop ALERT STATEMENT.
;;; Modified to place on a non plotting XLINE layer.
;;; Modified to add error coding.
;;; Modified to redefined variables
;;; Modified again to place on a non plotting G-ANNO-NPLT layer.
;;; |vp| - Get ViewPort object
;;; |ht| - Get Outside HeighT of Viewport
;;; |wd| - Get Oustide WiDth of Viewport
;;; |vn| - Get Viewport Number
;;; |ctr| - Get CenTeR of Viewport
;;; |ctrx| - Calculate X of Viewport CenTeR
;;; |ctry| - Caluculate Y of Viewport CenTeR
;;; |vs| - Get View Size of viewport
;;; |xp| - Calculate XP factor of viewport
;;; |iw| - Calculate Width of viewport
;;; |bl| - Calculate Bottom Left corner of viewport
;;; |br| - Calculate Bottom Right corner of viewport
;;; |tr| - Calculate Top Right corner of viewport
;;; |tl| - Calculate Top Left corner of viewport
;;; |plinewid| - Save Pline Width
;;; |osmode| - Save OSmode
;;; VPL error code
(defun |vplerror| (|msg|)
(if (or (= |msg| "Function cancelled")
(= |msg| "quit / exit abort")
)
(princ (strcat "\nError: " |msg|))
)
(command ".ucs" "p") ;Restore UCS back
(setvar "clayer" |clayer|) ;Restore old Current Layer
(setvar "cmdecho" |cmdecho|) ;Restore old CMDECHO
(setvar "osmode" |osmode|) ;Restore osmode
(setq *error* |olderror|) ;Restore old Error
(command ".pspace") ;Go Back To Papserspace
(command "undo" "end") ;End UNDO
(princ)
)
;;; alert statement
;;; (alert "\nMake sure DEFPOINTS layer is On and Thawed! ")
;;; start function and define variables
(defun c:vpl (/ |vp| |ht| |wd| |vn|
|ctr| |ctrx| |ctry| |vs| |xp|
|iw| |bl| |br| |tr| |tl|
|osmode| |clayer| |cmdecho| |olderror|
|vplerror|
)
(command "undo" "begin") ;Set UNDO
(setq |olderror| *error*) ;Get current Error
(setq *error* |vplerror|) ;Set Error
(setq |clayer| (getvar "clayer")) ;Get current Layer
(setq |cmdecho| (getvar "cmdecho")) ;Get CMDECHO
(setq |osmode| (getvar "osmode")) ;Get OSMODE
(setvar "cmdecho" 0) ;Turn off command echoing
(command ".pspace") ;Enter pspace
(if (tblsearch "layer" "defpoints")
(command "_.-layer" "_thaw" "defpoints" "_on" "defpoints" "")
)
(setq ss (ssget "_:L"))
(setq |vp| (entget ;Select viewport boundary
(car (entsel "\nSelect Viewport to Draw Boundary in "))
)
)
(setq |ht| (cdr (assoc 41 |vp|))) ;Get Viewport height with
(setq |wd| (cdr (assoc 40 |vp|))) ;Get Viewport width with
(setq |vn| (cdr (assoc 69 |vp|))) ;Get Viewport Number
(command ".mspace") ;enter mspace
(setvar "cvport" |vn|) ;Set correct viewport
(command ".ucs" "v") ;Set UCS to View
(setq |ctr| (getvar "viewctr")) ;Get VIEWCTR store as CTR
(setq |ctrx| (car |ctr|)) ;Get X of CTR
(setq |ctry| (cadr |ctr|)) ;Get Y of CTR
(setq |vs| (getvar "viewsize")) ;Get inside Viewport height
(setq |xp| (/ |ht| |vs|)) ;Get XP Factor with HeighT /
;View Size
(setq |iw| (* (/ |vs| |ht|) |wd|)) ;Get inside width of Viewport by
(setq |bl| (list (- |ctrx| (/ |iw| 2)) (- |ctry| (/ |vs| 2))))
;Find four corners of Viewport
(setq |br| (list (+ |ctrx| (/ |iw| 2)) (- |ctry| (/ |vs| 2))))
(setq |tr| (list (+ |ctrx| (/ |iw| 2)) (+ |ctry| (/ |vs| 2))))
(setq |tl| (list (- |ctrx| (/ |iw| 2)) (+ |ctry| (/ |vs| 2))))
(setvar "osmode" 0) ;Turn off Osnaps
(command ".pline" |bl| |br| |tr| |tl| "c") ;Draw pline inside border
(command ".ucs" "p") ;Restore UCS back
(setvar "clayer" |clayer|) ;Restore old Current Layer
(setvar "cmdecho" |cmdecho|) ;Restore old CMDECHO
(setvar "osmode" |osmode|) ;Restore osmode
(setq *error* |olderror|) ;Restore old Error
(command ".pspace") ;Go Back To Papserspace
(command "undo" "end") ;End UNDO
(princ) ;Clean up command prompt
)
;;; |vp| - Get ViewPort object
;;; |vn| - Get Viewport Number
;;; |ctr| - Get CenTeR of Viewport
;;; |vs| - Get View Size of viewport
;;; |plinewid| - Save PlineWid
;;; |osmode| - Save OSmode
;;; VPC error code
(defun |vpcerror| (|msg|)
(if (or (= |msg| "Function cancelled")
(= |msg| "quit / exit abort")
)
(princ (strcat "\nError: " |msg|))
)
(command ".ucs" "p") ;Restore UCS back
(setvar "clayer" |clayer|) ;Restore old Current Layer
(setvar "cmdecho" |cmdecho|) ;Restore old CMDECHO
(setvar "osmode" |osmode|) ;Restore osmode
(setq *error* |olderror|) ;Restore old Error
(command ".pspace") ;Go Back To Papserspace
(princ)
)
(defun c:CSC (/ ss2 ss i)
(vl-load-com)
(setq ss (ssget "P"))
(if (setq ss2 (ssadd)
ss (ssget "P")
)
(progn
(repeat (setq i (sslength ss))
(ssadd
(vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (ssname ss (setq i (1- i))))))
ss2
)
)
(vl-cmdf "_.chspace" ss2 "" "")
(command "._pspace")
)
)
(princ)
)
(defun c:CGC (/ ss2 ss i)
(c:vpl)
(c:csc)
)
;(c:cgc)
I have 2 problems:
1. Program working properly on rectangular viewports only
but I need it on polygonal viewports too.
2. Now program need two selections: one - for viewport in order to draw outline
and second one - for change space
Is it possible to use one selection only (for PS entities and viewport)?
Any help will be very appreciated
Solved! Go to Solution.
