Topic: stretch objects by color

[ELOQUINTET]

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?

Code: [Select]

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

[ronjonp]

Code: [Select]

(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

[ELOQUINTET]

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?

[ELOQUINTET]

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  

[whdjr]

Try this:

Code: [Select]

(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.

[t-bear]

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

[ELOQUINTET]

ha good one bear, my thoughts exactly but it's the first week so i'm not saying anything (yet)