Visual LISP, AutoLISP and General Customization

Reply
Distinguished Contributor
msarqui
Posts: 126
Registered: ‎09-14-2010
Message 1 of 7 (347 Views)
Accepted Solution

Error in my routine

347 Views, 6 Replies
02-15-2013 08:33 PM

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.

Distinguished Mentor
Moshe-A
Posts: 735
Registered: ‎09-14-2003
Message 2 of 7 (316 Views)

Re: Error in my routine

02-15-2013 11:55 PM in reply to: msarqui

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:smileyfrustrated:etColor)
(c:MakeViewportOutline)
(c:RectWidth)

 

Cheers,

Moshe

 

Distinguished Contributor
area51visitor
Posts: 116
Registered: ‎03-05-2011
Message 3 of 7 (318 Views)

Re: Error in my routine

02-15-2013 11:55 PM in reply to: msarqui

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.

 

 

 

 

- Brian
"Very funny, Scotty. Now beam down my clothes."
*Expert Elite*
pbejse
Posts: 2,406
Registered: ‎11-24-2009
Message 4 of 7 (299 Views)

Re: Error in my routine

02-16-2013 02:52 AM in reply to: msarqui

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

 

 

Distinguished Contributor
msarqui
Posts: 126
Registered: ‎09-14-2010
Message 5 of 7 (267 Views)

Re: Error in my routine

02-18-2013 05:27 PM in reply to: pbejse

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.

*Expert Elite*
pbejse
Posts: 2,406
Registered: ‎11-24-2009
Message 6 of 7 (236 Views)

Re: Error in my routine

02-19-2013 08:16 PM in reply to: msarqui

msarqui wrote:

 

pbejse : Perfect solution for not having to select objects, it works nice.

 


Glad I could help

 

Kudos to alanjt_ & gile. 

 

Valued Contributor
marko_ribar
Posts: 93
Registered: ‎12-04-2011
Message 7 of 7 (224 Views)

Re: Error in my routine

02-20-2013 03:54 AM in reply to: pbejse

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)
)
;------------------------------------

 

Marko Ribar, d.i.a. (graduated engineer of architecture)

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community