Select Text,Line and poly line automatically colour change

Select Text,Line and poly line automatically colour change

Gaganpatel
Collaborator Collaborator
698 Views
5 Replies
Message 1 of 6

Select Text,Line and poly line automatically colour change

Gaganpatel
Collaborator
Collaborator

Dear Sir,

 

I want to select Text, Line, Poly Line automatically colour changes lisp file.

0 Likes
Accepted solutions (1)
699 Views
5 Replies
Replies (5)
Message 2 of 6

paullimapa
Mentor
Mentor

Answer may be here 

https://www.theswamp.org/index.php?topic=46787.0

 

(defun c:test ( / col idx sel )
  (if
        (and
            (setq sel (ssget "_:L"'((0 . "Line,Text,*polyline"))))
            (setq col (acad_truecolordlg 1))
        )
        (repeat (setq idx (sslength sel))
            (entmod (append (entget (ssname sel (setq idx (1- idx)))) col))
        )
  ) ; if
) ; defun

 

 


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 3 of 6

Gaganpatel
Collaborator
Collaborator

Thank you

i want to first particular colour set then select MTEXT, TEXT, LINE & POLYLINE automatically colour changes.

0 Likes
Message 4 of 6

paullimapa
Mentor
Mentor
Accepted solution

Give this modified version a try.

First time run ChgObjCol will bring up a color selection box before selecting Lines, Plines, Text, Mtext to change

Thereafter, when run ChgObjCol it'll automatically use the same selected color value for color changes.

Also the same applies to all currently opened drawings and future opened drawings in the same AutoCAD session.

If you want to reset the color, run the ResetCol command.

 

 

; ChgObjCol changes specified objects colors based on preselected value
; ResetCol offers color dialog to select new color value for object color change
; OP Response 
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-text-line-and-poly-line-automatically-colour-change/m-p/11811555#M444866
(defun c:ChgObjCol ( / ed en idx obj sel)
  (setq obj "Line,*Text,*Polyline") ; modify string of objects separated by comma to change colors
  (if(not **col**)(c:ResetCol))
  (princ(strcat"\nSelect Following Objects to Change Colors: <" obj ">"))
  (if (setq sel (ssget "_:L" (list (cons 0 obj)))) ; select matching objects on unlocked layer
    (progn
      (repeat (setq idx (sslength sel)) ; loop through selection
       (setq en (ssname sel (setq idx (1- idx)))) ; get entity
       (setq ed (entget en)) ; get entity data list 
       (if (assoc 420 ed) ; chk if truecolor assoc exists
        (setq ed (entmod (vl-remove (assoc 420 ed) ed))) ; remove it
       )
       (if (assoc 62 ed) ; chk if color assoc exists
        (setq ed (entmod (vl-remove (assoc 62 ed) ed))) ; remove it
       )
       (entmod (append ed **col**)) ; change objects color value by adding
      ) ; repeat
      (princ(strcat"\nChange Colors of " (itoa (sslength sel)) " Objects."))(princ)
    ) ; progn
    (progn
      (princ"\nNo Supported Objects Selected.")(princ)
    )
  ) ; if
  (princ)
) ; defun
(defun c:ResetCol (/ col)
  (if **col** (progn(setq col (cdr(assoc 62 **col**)))(setq **col** nil))(setq col 1))
  (vl-propagate '**col**)(princ) 
  (while(not **col**)               ; select color value if not already done
    (princ"\nSelect Color Value to Change Objects")(princ)
    (setq **col** (acad_truecolordlg col))
  ) ; while
  (vl-propagate '**col**)(princ) ; propagate color selected to current, all opened & subsequent drawings opened in current session
) ; defun
(princ"ChgObjCol - Select Objects To Change Color\nResetCol - Select New Color Value")(princ)

 

 

 


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 5 of 6

Gaganpatel
Collaborator
Collaborator

Thank you very much sir

0 Likes
Message 6 of 6

paullimapa
Mentor
Mentor

glad to have helpd...cheers!!!


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes