TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: mohan on March 05, 2023, 12:18:13 PM

Title: Color as per above text value
Post by: mohan on March 05, 2023, 12:18:13 PM
When I select Polyline & it's text above the route will read the text value & change the polyline color
The colors for the value is given in the Legend as attached dwg file

Multiple selection is preferred

1.) Legend dwg
2.) Route to be testing file both are attached
Title: Re: Color as per above text value
Post by: ribarm on March 05, 2023, 03:12:44 PM
Not sure ab selection, will it work without checking closest points, but try this cobbled version, maybe it succeeds...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo ( / ss sl st i txt lw lwx val )
  2.   (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE,TEXT"))))
  3.     (progn
  4.       (sssetfirst nil ss)
  5.       (setq sl (ssget "_I" (list (cons 0 "LWPOLYLINE"))))
  6.       (sssetfirst nil ss)
  7.       (setq st (ssget "_I" (list (cons 0 "TEXT"))))
  8.       (sssetfirst)
  9.       (repeat (setq i (sslength st))
  10.         (setq txt (ssname st (setq i (1- i))))
  11.         (setq lw (ssname sl i))
  12.         (setq lwx (entget lw))
  13.         (setq val (atof (cdr (assoc 1 (entget txt)))))
  14.         (cond
  15.           ( (<= val 10.0)
  16.             (if (assoc 62 lwx)
  17.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 252) (assoc 62 lwx) lwx)))))
  18.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 252)))))))
  19.             )
  20.           )
  21.           ( (<= 10.0 val 25.0)
  22.             (if (assoc 62 lwx)
  23.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 10) (assoc 62 lwx) lwx)))))
  24.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 10)))))))
  25.             )
  26.           )
  27.           ( (<= 25.0 val 40.0)
  28.             (if (assoc 62 lwx)
  29.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 231) (assoc 62 lwx) lwx)))))
  30.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 231)))))))
  31.             )
  32.           )
  33.           ( (<= 40.0 val 55.0)
  34.             (if (assoc 62 lwx)
  35.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 40) (assoc 62 lwx) lwx)))))
  36.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 40)))))))
  37.             )
  38.           )
  39.           ( (<= 55.0 val 70.0)
  40.             (if (assoc 62 lwx)
  41.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 31) (assoc 62 lwx) lwx)))))
  42.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 31)))))))
  43.             )
  44.           )
  45.           ( (<= 70.0 val 85.0)
  46.             (if (assoc 62 lwx)
  47.               (entupd (cdr (assoc -1 (entmod (setq lwx (subst (cons 62 123) (assoc 62 lwx) lwx))))))
  48.               (entupd (cdr (assoc -1 (entmod (setq lwx (append lwx (list (cons 62 123))))))))
  49.             )
  50.             (if (assoc 420 lwx)
  51.               (entupd (cdr (assoc -1 (entmod (subst (cons 420 8968112) (assoc 420 lwx) lwx)))))
  52.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 420 8968112)))))))
  53.             )
  54.           )
  55.           ( (<= 85.0 val 100.0)
  56.             (if (assoc 62 lwx)
  57.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 104) (assoc 62 lwx) lwx)))))
  58.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 104)))))))
  59.             )
  60.           )
  61.         )
  62.       )
  63.     )
  64.   )
  65.   (princ)
  66. )
  67.  
Title: Re: Color as per above text value
Post by: ribarm on March 05, 2023, 03:26:44 PM
Modified and catastrophic terribly slow...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo ( / car-sort ss sl st i txt p lw lwx val )
  2.  
  3.   (defun car-sort ( lst cmp / rtn )
  4.     (setq rtn (car lst))
  5.     (foreach itm (cdr lst)
  6.       (if (apply cmp (list itm rtn))
  7.         (setq rtn itm)
  8.       )
  9.     )
  10.     rtn
  11.   )
  12.  
  13.   (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE,TEXT"))))
  14.     (progn
  15.       (sssetfirst nil ss)
  16.       (setq sl (ssget "_I" (list (cons 0 "LWPOLYLINE"))))
  17.       (setq lwl (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sl))))
  18.       (sssetfirst nil ss)
  19.       (setq st (ssget "_I" (list (cons 0 "TEXT"))))
  20.       (sssetfirst)
  21.       (repeat (setq i (sslength st))
  22.         (setq txt (ssname st (setq i (1- i))))
  23.         (setq p (cdr (assoc 10 (entget txt))))
  24.         (setq lw (car-sort lwl (function (lambda ( a b ) (< (distance (vlax-curve-getstartpoint a) p) (distance (vlax-curve-getstartpoint b) p))))))
  25.         (setq lwx (entget lw))
  26.         (setq val (atof (cdr (assoc 1 (entget txt)))))
  27.         (cond
  28.           ( (<= val 10.0)
  29.             (if (assoc 62 lwx)
  30.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 252) (assoc 62 lwx) lwx)))))
  31.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 252)))))))
  32.             )
  33.           )
  34.           ( (<= 10.0 val 25.0)
  35.             (if (assoc 62 lwx)
  36.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 10) (assoc 62 lwx) lwx)))))
  37.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 10)))))))
  38.             )
  39.           )
  40.           ( (<= 25.0 val 40.0)
  41.             (if (assoc 62 lwx)
  42.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 231) (assoc 62 lwx) lwx)))))
  43.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 231)))))))
  44.             )
  45.           )
  46.           ( (<= 40.0 val 55.0)
  47.             (if (assoc 62 lwx)
  48.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 40) (assoc 62 lwx) lwx)))))
  49.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 40)))))))
  50.             )
  51.           )
  52.           ( (<= 55.0 val 70.0)
  53.             (if (assoc 62 lwx)
  54.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 31) (assoc 62 lwx) lwx)))))
  55.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 31)))))))
  56.             )
  57.           )
  58.           ( (<= 70.0 val 85.0)
  59.             (if (assoc 62 lwx)
  60.               (entupd (cdr (assoc -1 (entmod (setq lwx (subst (cons 62 123) (assoc 62 lwx) lwx))))))
  61.               (entupd (cdr (assoc -1 (entmod (setq lwx (append lwx (list (cons 62 123))))))))
  62.             )
  63.             (if (assoc 420 lwx)
  64.               (entupd (cdr (assoc -1 (entmod (subst (cons 420 8968112) (assoc 420 lwx) lwx)))))
  65.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 420 8968112)))))))
  66.             )
  67.           )
  68.           ( (<= 85.0 val 100.0)
  69.             (if (assoc 62 lwx)
  70.               (entupd (cdr (assoc -1 (entmod (subst (cons 62 104) (assoc 62 lwx) lwx)))))
  71.               (entupd (cdr (assoc -1 (entmod (append lwx (list (cons 62 104)))))))
  72.             )
  73.           )
  74.         )
  75.       )
  76.     )
  77.   )
  78.   (princ)
  79. )
  80.  

HTH.
M.R.
Title: Re: Color as per above text value
Post by: ribarm on March 05, 2023, 04:10:35 PM
Here is your file - finished with my second - better code (more reliably, but slower)...
Title: Re: Color as per above text value
Post by: mohan on March 12, 2023, 12:31:19 AM
Thanks for all of your hard work & time saving routine, Works perfectly.  :smitten:
Title: Re: Color as per above text value
Post by: ronjonp on March 14, 2023, 01:16:41 PM
Marko .. why not return the color then adjust at the end like so:
Code - Auto/Visual Lisp: [Select]
  1. (if (setq i (cond ((<= val 10.0) 252)
  2.                                ((<= 10.0 val 25.0) 10)
  3.                                ((<= 25.0 val 40.0) 231)
  4.                                ((<= 40.0 val 55.0) 40)
  5.                                ((<= 55.0 val 70.0) 31)
  6.                                ((<= 70.0 val 85.0) 123)
  7.                                ((<= 85.0 val 100.0) 104)
  8.                          )
  9.                  )
  10.                (entmod (append lwx (list (cons 62 i))))
  11.              )
Title: Re: Color as per above text value
Post by: ribarm on March 14, 2023, 01:22:02 PM
(<= 70 val 85) has both DXF 62 and DXF 420...
And I didn't looked to make it concise, just to make working example...