Hello everybody,
I have been using one routine very successfully to create a pline in modelspace that has the outline of the chosen viewports in the drawing. This one works great.
Now I am trying add other routines that I've done to better fit my needs. If I use each routine individually at the command line they work, but when I use all in a single command I got the following errors:
The routine SetColor - does not change color to Bylayer
The routine RectWidth - ; error: bad SSGET list
Why?
See the attached file for more details and be free to improve whatever you want in my routines because they are very basic.
And, if I am not asking to much, is that possible to not be prompt to select objects? I mean, the routine could automatically select all viewports in the drawing...
Thanks for helping.
Solved! Go to Solution.
Solved by pbejse. Go to Solution.
Msargui,
Add this line after (c:MakeViewportOutline) and before your (c:RectWidth)
(setvar 'ctab "Model")
by the way prefixing the function name with 'C:' declars it as a new autocad command
(that can be call from the command line).
if you do not intend to call these functions individually? you can remove the 'C:' prefix, (c:vpo) is sufficient.
(c:MakeLayer)
(c:SetColor)
(c:MakeViewportOutline)
(c:RectWidth)
Cheers,
Moshe
I didn't troubleshoot your code but found one here: http://www.jtbworld.com/lisp/vp-outline.htm by Jimmy Bergmark and modified it to be on your layer and with your command "VPO". It appears to work well.
@msarqui wrote:Hello everybody,
Why?
Thanks for helping.
(defun c:VPO () (setvar 'pickfirst 1) (c:MakeLayer) (c:SetColor) (sssetfirst nil (ssget "_x" '((0 . "VIEWPORT")))) (c:MakeViewportOutline) (c:RectWidth) )
(defun c:Rectwidth (/ wd ltscl) (if (setq pl (ssget "_X" '((0 . "LWPOLYLINE")(8 . "Tx-Viewport")(410 . "Model")))) (progn (command "._pedit" "_m" pl "" "w" "200" "") (command "._chprop" pl "" "ltscale" "1000" "") ) ) )
HTH
Hello guys,
Moshe-A : Thanks for the tip. I did not know I could write the commands without the "c" prefix.
bcinnv : I was intrigued when you said you didn't troubleshoot my code so I spent the weekend testing all possibilities and could not solve. Today when I went to work, I tested the routine in the office and it worked without problems. I think I inadvertently changed a system variable and now the routine does not work on my home computer. What I need do is to figure out which variable I changed.
pbejse : Perfect solution for not having to select objects, it works nice.
I made a cosmetic change in your Rectwidth suggestion and it works very well.
(defun c:Rectwidth (/ pl)
(if (setq pl (ssget "_X" '((0 . "LWPOLYLINE")(8 . "Tx-Viewport")(410 . "Model"))))
(progn
(command "._pedit" "_m" pl "" "w" "200" "")
(command "._chprop" pl "" "ltscale" "1000" "")
)
)
(princ)
)
Thanks for all the replies.
Nice codes from Alan, Gile, pbjese, you and I couldn't resist to add something mine...
Hope this is what you're looking for...
M.R.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Load all Linetypes from acadiso.lin file ;; ;; from: ribarm ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:Loadltypes ( / fn f rl ltname ltypes ) (setq fn (open (setq f (findfile "acadiso.lin")) "r")) (while (setq rl (read-line fn)) (if (eq "*" (substr rl 1 1)) (setq ltname (substr rl 1 (vl-string-position (ascii ",") rl)))) (if ltname (progn (setq ltname (vl-string-left-trim "*" ltname)) (setq ltypes (cons ltname ltypes)) ) ) ) (foreach ln ltypes (command "_.linetype" "l" f "" "s" ln "") ) (command "_.linetype" "s" "ByLayer" "") (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Make a layer Tx-Viewport ;; ;; from: msarqui ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun C:Makelayer () (if (not (tblsearch "LAYER" "Tx-Viewport")) (command "-layer" "m" "Tx-Viewport" "lt" "hidden" "" "c" "191" "" "") ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Set th current color Bylayer ;; ;; from: msarqui ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;if the color of the current layer in the Color Control of the Properties Toolbar; ;is set to another color then Bylayer, the new layer Tx-Viewport will assume the ; ;color 191 but will not show it. So I forced the system variable "cecolor" to 256; (defun c:SetColor () (setvar "cecolor" "BYLAYER") (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Outline-projection-all-viewports-to-m... ;; Make a viewport outline ;; ;; from : alanjt_ & gile ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:MakeViewportOutline (/ _trans _cornersFromBBox ss i ent data ent2 lst) ;; Viewport Outline ;; Require subroutine: PCS2WCS (and all subs it requires) ;; PCS2WCS by gile (http://www.theswamp.org/index.php?topic=29231.msg347755#msg347755) ;; Alan J. Thompson, 12.08.11 (vl-load-com) (defun _trans (p) (cons 10 (PCS2WCS p ent))) (defun _cornersFromBBox (o / a b) (vla-getboundingbox o 'a 'b) (setq a (_trans (vlax-safearray->list a)) b (_trans (vlax-safearray->list b)) ) (list a (list (car a) (cadr a) (caddr b)) b (list (car b) (cadr b) (caddr a))) ) (if (setq ss (ssget '((0 . "VIEWPORT")))) (repeat (setq i (sslength ss)) (setq ent (ssname ss (setq i (1- i))) data (entget ent) ) (if (if (setq ent2 (cdr (assoc 340 data))) (setq lst (apply 'append (mapcar '(lambda (x) (if (eq (car x) 10) (list (_trans (cdr x))) ) ) (entget ent2) ) ) ) (setq lst (_cornersFromBBox (vlax-ename->vla-object ent))) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) '(70 . 1) '(410 . "Model") ) lst ) ) ) ) ) (princ) ) ;; WCS2PCS (gile) ;; Translates a point WCS coordinates to the PaperSpace CS according to ;; the specified Viewport ;; ;; (WCS2PCS pt vp) is the same as (trans (trans pt 0 2) 2 3) when vp is active ;; ;; Arguments ;; pt : a point ;; vp : the viewport (ename or vla-object) (defun WCS2PCS (pt vp / elst ang nor scl mat) (vl-load-com) (and (= (type vp) 'VLA-OBJECT) (setq vp (vlax-vla-object->ename vp)) ) (setq pt (trans pt 0 0) elst (entget vp) ang (cdr (assoc 51 elst)) nor (cdr (assoc 16 elst)) scl (/ (cdr (assoc 41 elst)) (cdr (assoc 45 elst))) mat (mxm (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0) ) (mapcar (function (lambda (v) (trans v nor 0 T))) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) ) ) ) (mapcar '+ (vxs (mxv mat (mapcar '- pt (cdr (assoc 17 elst)))) scl) (vxs (cdr (assoc 12 elst)) (- scl)) (cdr (assoc 10 elst)) ) ) ;; PCS2WCS (gile) ;; Translates a point PaperSpace coordinates to WCS coordinates ;; according to the specified viewport ;; ;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active ;; ;; Arguments ;; pt : a point ;; vp : the viewport (ename or vla-object) (defun PCS2WCS (pt vp / ang nor scl mat) (vl-load-com) (and (= (type vp) 'VLA-OBJECT) (setq vp (vlax-vla-object->ename vp)) ) (setq pt (trans pt 0 0) elst (entget vp) ang (- (cdr (assoc 51 elst))) nor (cdr (assoc 16 elst)) scl (/ (cdr (assoc 45 elst)) (cdr (assoc 41 elst))) mat (mxm (mapcar (function (lambda (v) (trans v 0 nor T))) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) ) (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0) ) ) ) (mapcar '+ (mxv mat (mapcar '+ (vxs pt scl) (vxs (cdr (assoc 10 elst)) (- scl)) (cdr (assoc 12 elst)) ) ) (cdr (assoc 17 elst)) ) ) ;; VXS Multiply a vector by a scalar ;; ;; Arguments : a vector and a real (defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v)) ;; VXV (gile) ;; Returns the dot product of two vectors (real) ;; ;; Arguments : two vectors ;; return : a real number (defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2))) ;; TRP ;; transposes a matrix -Doug Wilson- ;; ;; Argument : a matrix ;; return : a matrix (defun trp (m) (apply 'mapcar (cons 'list m))) ;; MXV ;; Applies a transformation matrix to a vector -Vladimir Nesterovsky- ;; ;; Arguments : une matrice et un vecteur ;; return : a vector (defun mxv (m v) (mapcar '(lambda (r) (vxv r v)) m) ) ;; MXM ;; Multiplies (combinates) two matrices -Vladimir Nesterovsky- ;; ;; Arguments : deux matrices ;; return : a matrix (defun mxm (m q) (mapcar '(lambda (r) (mxv (trp q) r)) m) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Change the width and the ltscale of the projected viewport outlines ;; ;; to make them more visible ;; ;; from: msarqui & a little help from pbejse ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:Rectwidth ( / pl r ) (if (setq pl (ssget "_X" '((0 . "LWPOLYLINE")(8 . "Tx-Viewport")(410 . "Model")))) (progn (command "._pedit" "_m" pl "" "w" (if (eq (setq r (fix (/ (getvar 'viewsize) 200.0))) 0) 0.1 r) "") (command "._chprop" pl "" "ltscale" (if (eq r 0) 1.0 r) "") ) ) (princ) ) ;------------------------------------ ;shortcut (defun c:VPO ( / pck ss ) (setq pck (getvar 'pickfirst)) (setvar 'pickfirst 1) (c:Loadltypes) (c:MakeLayer) (c:SetColor) (foreach lay (layoutlist) (setvar 'ctab lay) (sssetfirst nil (ssdel (ssname (setq ss (ssget "_X" (list '(0 . "VIEWPORT") (cons 410 (getvar 'ctab))))) (- (sslength ss) 1)) ss)) (c:MakeViewportOutline) ) (setvar 'tilemode 1) (command "_.zoom" "e") (c:RectWidth) (command "_.zoom" "e") (setvar 'pickfirst pck) ) ;------------------------------------
Can't find what you're looking for? Ask the community or share your knowledge.