Topic: Color as per above text value

[mohan]

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

[ribarm]

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.  

[ribarm]

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.

[ribarm]

Here is your file - finished with my second - better code (more reliably, but slower)...

[mohan]

Thanks for all of your hard work & time saving routine, Works perfectly. 

[ronjonp]

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

[ribarm]

(<= 70 val 85) has both DXF 62 and DXF 420...
And I didn't looked to make it concise, just to make working example...