TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ELOQUINTET on March 03, 2005, 11:30:11 AM
-
i have this lisp which stretches objects on selected layers. at my new job they don't use very many layers but instead change the color. i would like to modify this to do it according to color instead. is this possible and if so how would i modify this?
;;; STRETCHES SPECIFIC LAYERS ONLY
(defun c:SL
(/ layer_string ent enlay entlst ename olderr selset enum objlen dent layent layset lay pt1 pt2 ss ss1 ss2 en osm)
(vl-load-com)
(if (null myerr)(load "myerr"))
(setq olderr *error* *error* myerr)
(setq osm (getvar "osmode"))
(if (null setvars)(load "setvars"))
(setq syslst
(setvars '(("cmdecho" . 0) ("osmode" . 0) ("trimmode" . 1)) )
)
(while (setq ent (entsel "\nSelect entity on layer..."))
(setq layer_string
(if layer_string
(strcat layer_string ","
(vla-get-layer (vlax-ename->vla-object (car ent)))
)
(vla-get-layer (vlax-ename->vla-object (car ent)))
)
)
)
(princ "\nSelect objects to stretch by crossing-window or crossing-polygon...")
(command "._stretch" (ssget (list (cons 8 layer_string))) "")
(setvars syslst)
(setq *error* olderr)
(princ)
)
(defun myerr (msg)
(if (or (= msg "quit / exit abort")
(= msg "Function cancelled"))
(if (and ctl undo_err) ; if undo_start used and returned value saved
(undo_err ctl)) ; in ctl then undo everything done so far.
(princ msg))
(if (and setvars syslst) ; if usual system var handler and variable exist
(setvars syslst)) ; then restore system vars
(setq *error* OLDERR ctl nil)
(princ)
)
(defun setvars (syslst / oldlst)
(foreach dp syslst
(setq oldlst (cons
(cons (car dp) (getvar (car dp)))
oldlst)))
(foreach dp syslst
(setvar (car dp) (cdr dp))
)
oldlst
)
(princ)
-
(defun c:SL
(/ layer_string ent enlay entlst ename
olderr selset enum objlen dent layent layset
lay pt1 pt2 ss ss1 ss2 en
osm
)
(vl-load-com)
(if (null myerr)
(load "myerr")
)
(setq olderr *error*
*error* myerr
)
(setq osm (getvar "osmode"))
(if (null setvars)
(load "setvars")
)
(setq syslst
(setvars '(("cmdecho" . 0) ("osmode" . 0) ("trimmode" . 1)))
)
(while (setq ent (entsel "\nSelect entity color.."))
(setq layer_string
(if layer_string
(strcat layer_string
","
(vla-get-color (vlax-ename->vla-object (car ent)))
)
(vla-get-color (vlax-ename->vla-object (car ent)))
)
)
)
(princ
"\nSelect objects to stretch by crossing-window or crossing-polygon..."
)
(command "._stretch"
(ssget (list (cons 62 layer_string)))
""
)
(setvars syslst)
(setq *error* olderr)
(princ)
)
(defun myerr (msg)
(if (or (= msg "quit / exit abort")
(= msg "Function cancelled")
)
(if (and ctl undo_err) ; if undo_start used and returned value saved
(undo_err ctl)
) ; in ctl then undo everything done so far.
(princ msg)
)
(if (and setvars syslst) ; if usual system var handler and variable exist
(setvars syslst)
) ; then restore system vars
(setq *error* OLDERR
ctl nil
)
(princ)
)
(defun setvars (syslst / oldlst)
(foreach dp syslst
(setq oldlst (cons
(cons (car dp) (getvar (car dp)))
oldlst
)
)
)
(foreach dp syslst
(setvar (car dp) (cdr dp))
)
oldlst
)
(princ)
I changed (vla-get-layer (vlax-ename->vla-object (car ent))) to (vla-get-color (vlax-ename->vla-object (car ent)))
and
(ssget (list (cons 8 layer_string))) to
(ssget (list (cons 62 layer_string)))
It asks for two picks though
:?:
Ron
-
ok ron it works so far but one more request if you don't mind. how do i modify it so i can select multiple colors?
-
hmmm no responses i didn't think that was a big change. sigh it's so frustrating that they don't use layers i heavily used that stretch by layer lisp :x
-
Try this:
(defun c:SL (/ olderr *error* syslst ent elist clist)
;
(defun myerr (msg)
(if (or (= msg "quit / exit abort")
(= msg "Function cancelled")
)
(if (and ctl undo_err)
(undo_err ctl)
)
(princ msg)
)
(if (and setvars syslst)
(setvars syslst)
)
(setq *error* OLDERR
ctl nil
)
(princ)
)
;
(defun setvars (syslst / oldlst)
(foreach dp syslst
(setq oldlst (cons
(cons (car dp) (getvar (car dp)))
oldlst
)
)
)
(foreach dp syslst
(setvar (car dp) (cdr dp))
)
oldlst
)
;
(vl-load-com)
(setq olderr *error*
*error* myerr
)
(setq syslst (setvars '(("cmdecho" . 0) ("osmode" . 0) ("trimmode" . 1))))
(setvar "ErrNo" 0)
(while (/= (getvar "ErrNo") 52)
(cond ((= (getvar "ErrNo") 7)
(princ "\nSelection missed. Please try again.")
(setvar "ErrNo" 0)
)
((setq ent (car (entsel "\nSelect entity color(s): ")))
(setq elist (cons ent elist))
(princ (strcat "<1> Entity selected [" (itoa (length elist)) "] Total"))
)
)
)
(if elist
(and (setq clist (mapcar '(lambda (x)
(vla-get-color (vlax-ename->vla-object x))
)
elist
)
)
(setq clist (mapcar '(lambda (x) (cons 62 x)) clist))
(setq clist (append '((-4 . "<AND")) clist '((-4 . "AND>"))))
)
(princ "\nNothing selected!")
)
(prompt
"\nSelect objects to stretch by crossing-window or crossing-polygon..."
)
(if clist
(progn
(command "._stretch" (ssget clist))
(command "" pause pause)
)
)
(setvars syslst)
(setq *error* olderr)
(princ)
)
I didn't have time to configure it for finding the actual color of a bylayer entity. Sorry. Maybe later this weekend.
-
Work hard, be dilligent, and soon you'll be the CAD manager. THEN! you can make the ba$tards use layers like the rest of the civilized world.
OH yah ..... suck up a lot too LOLOL
-
ha good one bear, my thoughts exactly but it's the first week so i'm not saying anything (yet) :wink: