See the top rated post in this thread. Click here

Results 1 to 7 of 7

Thread: Changes all the text color selected area (text, mtext, attdef, blk def.) skip lines and xref

  1. #1
    Member
    Join Date
    2010-01
    Posts
    18
    Login to Give a bone
    0

    Default Changes all the text color selected area (text, mtext, attdef, blk def.) skip lines and xref

    Can someone update the routine?
    The whole thing is a combination of a number of separate lisp routines that do work themselves.
    I have tried to summarize this in 1 routine.
    The routine now makes everything to 1 color, especially lines. That's a bit too much of a good thing.
    The point is that, of a selectable area in the drawing, only the color of text objects is changed. text, attdef, mtext and attributes. So also the text in blocks.
    Changes all the text color in selected block definitions to color 2.
    Combine the selection set to one function. Misappplied the color of all entities wil be changed, only text objects must be changed

    Code:
    (defun C:CHTXTINSELBLOCKSCOLOR2 (/ ent el s1 blk_name num nval antw atel atoff e1 e2 en tag nl en C SS K CBL BLK CBL2 C ACL ALY NLY EE NCL NEWE eset cntr enlist pt BLKDATA NEWCOLOR NEWLAYER XREFFLAG XDEPFLAG BLKENTNAME COUNT ENTDATA OLDCOLOR BLKENTNAME *ERROR* ERR-UBC LAY_NAME LT OLDERR)
    
    (graphscr)
    (setvar "cmdecho" 0)
    (command "_undo" "_m")
    (prompt "\nCOLOR-TEXT-OBJECTS-IN-SELECTED-BLOCKS-TO-COLOR-2.LSP - Versie 1.0")
    (prompt "\nAutoCAD lisp routine voor het selecteren en wijzigen in blocks van de kleur van alle text-objecten in AutoCAD kleur 2 geel")
    (prompt "\nBehandelt geen XREF & geneste blokken")
    (graphscr)
      (setvar "cmdecho" 0)
      (setvar "attreq" 0)
      (command "undo" "mark")
      (princ "\n\rSelekteer een block waarvan je de attributen kleur wilt aanpassen !")
      (if (setq ent (car (entsel "\n<Wijs een blok aan = Automatisch>  / Enter=handmatig  >>")))
       (progn
        (setq el (entget ent))
        (if (= (cdr (assoc 0 el)) "INSERT")
         (progn
          ;(setq s1 (ssget "x" (list (cons 2 (cdr (assoc 2 el))))))
          (setq blk_name (cdr (assoc 2 el)) lay_name (cdr (assoc 8 el)))
          (setq s1 (ssget "x" (list (cons 2 blk_name) (cons 8 lay_name))))
          (princ (strcat "\nSelekteren van alle blokken:" blk_name " op laag:"lay_name ))
    
         )
        )
       )
       ;else
       (progn (princ "\n\rSelekteer een blok >>")
        (setq s1 (ssget))
       )
      )
      (if s1
       (progn (setq num (1- (sslength s1)) atoff '())
       (terpri) (terpri)
       (initget 1 "J j N n")
       (setq nval (getstring "\nNieuwe Attribuut kleur NUMMER :"))
       (setq antw (getstring "\Alle attribuut kleuren aanpassen  [J/N]"))
      (if  (or (= antw "N") (= antw "n"))
       (progn (while (setq ent (car (nentsel "\nVan elke attributen moeten de kleuren aangepast worden...>>")))
      (setq atel (entget ent))
       (setq atoff (append atoff (list (cdr (assoc 2 atel))))) ) ) )
      (while  (/= num -1)
       (setq e1 (ssname s1 num))
       (setq e2 (entget e1))
       (if (and (=  (cdr (assoc 66 e2)) 1)
                (= (cdr (assoc 0 e2)) "INSERT")
           )
      (progn
       (prompt"\e[2J")
       (princ (strcat "\rOgenblikje... Nog " (itoa num) " blokken.... " ))
       (setq en (entnext e1) el (entget en))
       (while (/= (cdr (assoc 0 el)) "SEQEND")
        (if (and (member (setq tag (cdr (assoc 2 el))) atoff))
         (progn
    ;(setq nl (cons 40 nval) ol (assoc 40 el) el (subst nl ol el))
    ;(entmod el)
         (command  "attedit" "y" "" "" "" (cdr (car el)) "color" nval "")
         )
          (if (or (= antw "J") (= antw "j"))
           (progn
    ;(setq nl (cons 40 nval) ol (assoc 40 el) el (subst nl ol el))
    ;(entmod el)
           (command "attedit" "y" "" "" "" (cdr (car el)) "color" nval "")
           )
          )
        )
        (setq en (entnext en) el (entget en))
       )
       (entupd en)
       )
      )
      (setq num (1- num)) ) ) )
    
    (defun err-ubc (s)				; If an error (such as CTRL-C) occurs
    						; while this command is active...
    	(if (/= s "Function cancelled")
      		(princ (strcat "\nError: " s))
    	)
    	(setq *error* olderr)			; Restore old *error* handler
    	(princ)
    );err-ubc
    
    	(setq olderr *error* *error* err-ubc)
    	(initget "?")
            (while
    		(or (eq (setq C (getint "\nType nieuw kleur code/<?>: ")) "?")
    		    (null C)
    		    (> C 256)
    		    (< C 0)
    		);or
    		(textscr)
    		(princ "\n                                                           ")
    		(princ "\n                 Kleur code     |   Kleur omschrijving     ")
    		(princ "\n                ________________|_________________________ ")
    		(princ "\n                                |                          ")
    
    		(princ "\n                       2        |      GEEL - YELLOW       ")
    		(princ "\n                                               \n\n\n")
    		(initget "?")
    	);while
    
    		(prompt "\nSelecteer blokken om bij te werken. ")
    
    	(SETQ SS (SSGET '((0 . "INSERT"))))
    	(SETQ K 0)
    	(WHILE (< K (SSLENGTH SS))
            	(setq CBL (tblsearch "BLOCK" (CDR (ASSOC 2 (ENTGET (SETQ BLK (SSNAME SS K)))))))
            	(SETQ CBL2 (CDR (ASSOC -2 CBL)))
    		(WHILE (BOUNDP 'CBL2)
    			(SETQ EE (ENTGET CBL2))
    
    			;Update layer value
     			(SETQ NCL (CONS 62 C))
    			(SETQ ACL (ASSOC 62 EE))
    			(IF (= ACL nil)
    				(SETQ NEWE (APPEND EE (LIST NCL)))
    				(SETQ NEWE (SUBST NCL ACL EE))
    			);if
    			(ENTMOD NEWE)
    
    			(SETQ CBL2 (ENTNEXT CBL2))
    		);end while
    		(ENTUPD BLK)
    		(SETQ K (1+ K))
    	);end while
    	(setq *error* olderr)
    	(princ)
    ;)
    
    (setq eset
    (ssget
    (list
    (cons -4 "<OR")
    (cons 0 "MTEXT")
    (cons 0 "TEXT")
    (cons -4 "OR>")
    )
    )
    )
    (if (and eset (> (sslength eset) 0))
    (progn
    (setq cntr 0 lt (getvar "dimscale"))
    (while(< cntr (sslength eset))
    (setq en(ssname eset cntr))
    (setq enlist(entget en))
    (setq pt(cdr(assoc 10 enlist)))
    (grclear)
    (redraw)
    (grdraw pt (setq pt(polar pt 2.9671 (* lt 12.2080))) 90 -1)
    (grdraw pt (setq pt(polar pt 0.7854 (* lt 4.5020))) 90 -1)
    (grdraw pt (setq pt(polar pt 2.3562 (* lt 20.0000))) 90 -1)
    (grdraw pt (setq pt(polar pt 0.7854 (* lt 5.0000))) 90 -1)
    (grdraw pt (setq pt(polar pt 5.4978 (* lt 20.0000))) 90 -1)
    (grdraw pt (setq pt(polar pt 0.7854 (* lt 4.5020))) 90 -1)
    (grdraw pt (setq pt(polar pt 4.8869 (* lt 12.2080))) 90 -1)
    (command "CHANGE" en "" "Properties" "Color" "2" "")
    (grdraw pt (setq pt(polar pt 2.9671 (* lt 12.2080))) 90 -1)
    (grdraw pt (setq pt(polar pt 0.7854 (* lt 4.5020))) 90 -1)
    (grdraw pt (setq pt(polar pt 2.3562 (* lt 20.0000))) 90 -1)
    (grdraw pt (setq pt(polar pt 0.7854 (* lt 5.0000))) 90 -1)
    (grdraw pt (setq pt(polar pt 5.4978 (* lt 20.0000))) 90 -1)
    (grdraw pt (setq pt(polar pt 0.7854 (* lt 4.5020))) 90 -1)
    (grdraw pt (setq pt(polar pt 4.8869 (* lt 12.2080))) 90 -1)
    (setq cntr(+ cntr 1))
    )
    )
    )
    (alert (strcat "Aantal gewijzigde text-veld-objecten en/of Mtext-veld-objecten: " (itoa cntr) "."))
    (grclear)
    (redraw)
    
    (command ".undo" "group")
       (setq BLKDATA (tblnext "BLOCK" t))
       (setq NEWCOLOR (cons 62 2))  ;this will set 62 (color) to 2
    ;   (setq NEWLAYER (cons 8 "0"))  ;this will set 8 (layer) to 0
       ; While there is an entry in the block table to process, continue
       (while BLKDATA
          (prompt "\nRedefining colors for block: ")
          (princ (cdr (assoc 2 BLKDATA)))
          ; Check to see if block is an XREF or is XREF dependent
          (setq XREFFLAG (assoc 1 BLKDATA))
          (setq XDEPFLAG (cdr (assoc 70 BLKDATA)))
          ; If block is not XREF or XREF dependent, i.e., regular block, then proceed.
          (if (and (not XREFFLAG) (/= (logand XDEPFLAG 32) 32))
             (progn
                (setq BLKENTNAME (cdr (assoc -2 BLKDATA)))
                (setq COUNT 1)
                (terpri)
                (while BLKENTNAME
                   (princ COUNT)
                   (princ "\r")
                   (setq ENTDATA (entget BLKENTNAME)); get entities data 
                   (setq OLDCOLOR (assoc 62 ENTDATA))  ;get entities old color value
                   (if OLDCOLOR                         ; if value exist (null = bylayer)
                      (entmod (subst newcolor oldcolor ENTDATA)) ; substitute old color to byblock
                      (entmod (cons newcolor ENTDATA))      ; modify ent data w/ byblock values
                   )
                   (setq BLKENTNAME (entnext BLKENTNAME)) ;if attributes exist, then edit next one
                   (setq COUNT (+ COUNT 1));
                ) ;end while for attribute trap
             ) ;progn
             (progn
                (princ "    XREF...skipping!")
             ) ;progn
          );end if not an Xref
          (setq BLKDATA (tblnext "BLOCK")) ;next block please
       ) ;end while loop of blk data available to edit
    (command ".undo" "end")
    (command ".regen")
    (setvar "cmdecho" 1)
    (prompt "\nDe AutoCAD-selecteren-en-wijzigen-van-de-kleur-van-text-objecten-in-blocks-naar-AutoCAD-kleur-2-geel-routine opdracht is be£indigd, er zijn geen objecten meer geselecteerd. Start de routine opnieuw met AutoCAD commando: CHTXTINSELBLOCKSCOLOR2")
    (princ)
    )
    The routine makes everything to 1 color, even lines and polylines. That's a bit too much of a good thing.
    The point is that, of a selectable area in the drawing, only the color of text objects is changed. text, attdef, mtext, attributes and text in blocks
    Last edited by Opie; 2022-08-25 at 12:49 PM. Reason: [code] tags added

  2. #2
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    9,096
    Login to Give a bone
    0

    Default Re: Changes all the text color selected area (text, mtext, attdef, blk def.) skip lines and xref

    I'm not understanding your post. Are you wanting to select a specific area of the drawing, which may change each time this is executed, to change the color of all text or attributes to ACI color 2? What should happen if a block is inserted into the drawing in multiple places with at least one of those places being within the specific area?

    Setting the attributes and text objects within a block to ByBlock for the color may ease some of your pain. You could then change the layer or block object color without additional code.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  3. #3
    Member
    Join Date
    2010-01
    Posts
    18
    Login to Give a bone
    0

    Default Re: Changes all the text color selected area (text, mtext, attdef, blk def.) skip lines and xref

    Yes to be able to select a specific area of the drawing, window of crossing, which is executed each time. Changing the color of text, mtext attdef etc. can be changed.
    Change the color of any text or attributes to ACI color. The selected blocks must be redefined, i.e. renamed and modified. for example blockname1 in blockname1(1)
    If block blockname1 is not in the selection, it should not be modified and should be renamed.
    I can manually adjust it in a drawing, but routines are there to make the work more pleasant.

    Must be a combination of:

    CopyRenameBlockV1-5.lsp (copy and rename a block)
    atcolor.lsp (change the attributes of block to a selected color code)
    update-block-color.lsp (Change all entites, the wish is only text elements)
    change-text-objects-to-color-2-yellow.lsp (select area and change the text color to 2)

  4. #4
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: Changes all the text color selected area (text, mtext, attdef, blk def.) skip lines and xref

    Quote Originally Posted by Remco Koedoot View Post
    Yes to be able to select a specific area of the drawing, window of crossing, which is executed each time. Changing the color of text, mtext attdef etc. can be changed.
    Change the color of any text or attributes to ACI color. The selected blocks must be redefined, i.e. renamed and modified. for example blockname1 in blockname1(1)
    If block blockname1 is not in the selection, it should not be modified and should be renamed.
    I can manually adjust it in a drawing, but routines are there to make the work more pleasant.

    Must be a combination of:

    CopyRenameBlockV1-5.lsp (copy and rename a block)
    atcolor.lsp (change the attributes of block to a selected color code)
    update-block-color.lsp (Change all entites, the wish is only text elements)
    change-text-objects-to-color-2-yellow.lsp (select area and change the text color to 2)
    Opie pointed out that changing the definition of a block affects every insertion of that block in the drawing which is why he suggested setting the attributes and text objects within a block to ByBlock for the color so you could then change the layer or block object color without additional code. You need to understand and explain how you want only the selected blocks to be modified.

    If you want us to combine lisps for you why didn't you provide links to where they could be found?
    Otherwise the list is useless.

  5. #5
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    1

    Default Re: Changes all the text color selected area (text, mtext, attdef, blk def.) skip lines and xref

    OK I took a step back and rather than try to debug your program I took the liberty to re-code it in my style.

    In my code I use a recursive function to drill down into blocks inside blocks etc... to get all of the selected objects.

    It creates a list of objects inside and attributes.

    Be aware if you have other instances of selected blocks... they will also change.

    Anyways...

    The act of changing color or any other property is relatively simple once you have the list of objects.

    Regards P-

    Code:
    ;___________________________________________________________________________________________________________|
    ;
    ; Written By: Peter Jamtgaard copyright 2022 All Rights Reserved
    ;___________________________________________________________________________________________________________|
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Comand line function list
    ;___________________________________________________________________________________________________________|
    
    ;* C:NestedObjects
    ;* Command line function to get a list of objects and nested objects from selection set 
    
    ;___________________________________________________________________________________________________________|
    ;
    ; General Function Header List
    ;___________________________________________________________________________________________________________|
    
    ;  Function List Argument1 Argument2 Arguement3
    
    ;* (AttributeObjectAdd objBlock)
    ;* Function to add an attribute object  to a list of objects 
    
    ;* (NestedObjects objSelection)
    ;* (Recursive) Function to get all nested and attribute objects from another object
    
    ;* (ObjectAdd objItem)
    ;* Function to add an object to a list of objects 
    
    ;$ End Header
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Command line function to get a list of objects and nested objects from selection set
    ;___________________________________________________________________________________________________________|
    
    (defun C:NestedObjects (/ entSelection intCount lstObjects objSelection ssSelections)
     (if (and (princ "\nSelect Objects: ")
              (setq ssSelections (ssget))
         )
      (repeat (setq intCount (sslength ssSelections))
       (setq intCount (1- intCount))
       (setq entSelection (ssname ssSelections intCount))
       (setq objSelection (vlax-ename->vla-object entSelection))
       (nestedobjects objSelection)
      )
     )
     (mapcar '(lambda (X)(vla-put-color X 1)) lstObjects)
     (reverse lstObjects)
    )
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Function to add an attribute object  to a list of objects 
    ;___________________________________________________________________________________________________________|
    
    (defun AttributeObjectAdd (objBlock / objAttribute)
     (if (= (vla-get-hasattributes objBlock) :vlax-true)
      (foreach objAttribute (vlax-invoke objBlock "getattributes")
       (objectadd objAttribute)
      )
     )
    )
    
    ;___________________________________________________________________________________________________________|
    ;
    ; (Recursive) Function to get all nested and attribute objects from another object
    ;___________________________________________________________________________________________________________|
    
    (defun NestedObjects (objSelection / colBlockReference objBlock strBlockName)
     (objectadd objSelection)
     (if (wcmatch (vla-get-objectname objSelection) "AcDbBlockReference,AcDbMInsertBlock")
      (progn
    
       (AttributeObjectAdd objSelection)
    
       (vlax-for objBlock (vla-item
                           (vla-get-blocks
                            (vla-get-document objSelection)
                           )
                           (vla-get-name objSelection)
                          )
        (NestedObjects objBlock)
       )
      )  
     )
    )
    
    ;___________________________________________________________________________________________________________|
    ;
    ; Function to add an object to a list of objects 
    ;___________________________________________________________________________________________________________|
    
    (defun ObjectAdd (objItem / strHandle)
     (if (not (member objItem lstObjects))
      (setq lstObjects (cons objItem lstObjects))
     )
    )
    
    (princ "!")
    (vl-load-com)
    Attached Files Attached Files
    AutomateCAD

  6. #6
    Member
    Join Date
    2010-01
    Posts
    18
    Login to Give a bone
    0

    Default Re: Changes all the text color selected area (text, mtext, attdef, blk def.) skip lines and xref

    First of all thanks for your reply.

    This routine will update the color only of attributes:

    ;;;; ATCOLOR-CONTENTS.LSP - AutoCAD lisp routine wijzigt de kleur eigenschap van te selecteren attributes

    (graphscr)
    (prompt "\nATCOLOR-CONTENTS.LSP - Versie 1.0")
    (prompt "\nWijzigt de kleur eigenschap van te selecteren attributes")
    (setvar "cmdecho" 0)
    (setvar "attreq" 0)
    (command "undo" "mark")
    (princ "\n\rSelekteer een block waarvan je de attributen kleur wilt aanpassen !")
    (if (setq ent (car (entsel "\n<Wijs een blok aan = Automatisch> / Enter=handmatig >>")))
    (progn
    (setq el (entget ent))
    (if (= (cdr (assoc 0 el)) "INSERT")
    (progn
    ;(setq s1 (ssget "x" (list (cons 2 (cdr (assoc 2 el))))))
    (setq blk_name (cdr (assoc 2 el)) lay_name (cdr (assoc 8 el)))
    (setq s1 (ssget "x" (list (cons 2 blk_name) (cons 8 lay_name))))
    (princ (strcat "\nSelekteren van alle blokken:" blk_name " op laag:"lay_name ))

    )
    )
    )
    ;else
    (progn (princ "\n\rSelekteer een blok >>")
    (setq s1 (ssget))
    )
    )
    (if s1
    (progn (setq num (1- (sslength s1)) atoff '())
    (terpri) (terpri)
    (initget 1 "J j N n")
    (setq nval (getstring "\nNieuwe Attribuut kleur NUMMER :"))
    (setq antw (getstring "\Alle attribuut kleuren aanpassen [J/N]"))
    (if (or (= antw "N") (= antw "n"))
    (progn (while (setq ent (car (nentsel "\nVan elke attributen moeten de kleuren aangepast worden...>>")))
    (setq atel (entget ent))
    (setq atoff (append atoff (list (cdr (assoc 2 atel))))) ) ) )
    (while (/= num -1)
    (setq e1 (ssname s1 num))
    (setq e2 (entget e1))
    (if (and (= (cdr (assoc 66 e2)) 1)
    (= (cdr (assoc 0 e2)) "INSERT")
    )
    (progn
    (prompt"\e[2J")
    (princ (strcat "\rOgenblikje... Nog " (itoa num) " blokken.... " ))
    (setq en (entnext e1) el (entget en))
    (while (/= (cdr (assoc 0 el)) "SEQEND")
    (if (and (member (setq tag (cdr (assoc 2 el))) atoff))
    (progn
    ;(setq nl (cons 40 nval) ol (assoc 40 el) el (subst nl ol el))
    ;(entmod el)
    (command "attedit" "y" "" "" "" (cdr (car el)) "color" nval "")
    )
    (if (or (= antw "J") (= antw "j"))
    (progn
    ;(setq nl (cons 40 nval) ol (assoc 40 el) el (subst nl ol el))
    ;(entmod el)
    (command "attedit" "y" "" "" "" (cdr (car el)) "color" nval "")
    )
    )
    )
    (setq en (entnext en) el (entget en))
    )
    (entupd en)
    )
    )
    (setq num (1- num)) ) ) )
    (prompt "\nDe AutoCAD-kleur-eigenschap-attribute-wijzigen-routine opdracht is beëindigd, er zijn geen attributes meer geselecteerd.")
    (princ)
    (princ "\nATCOLOR-CONTENTS.LSP - AutoCAD lisp routine wijzigt de kleur eigenschap van te selecteren attributes.")
    (princ)

  7. #7
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: Changes all the text color selected area (text, mtext, attdef, blk def.) skip lines and xref

    You need to edit your posts and use code tags instead of expecting an administrator to fix all of your posts.
    Click the [Go Advanced] button in the bottom right to get the full Toolbars.
    Click the # button and place your code inside.
    You can attach files as well but for code you've downloaded providing a link to where you downloaded it provides the best background as to what the lisp is supposed to do and who wrote the code and would be able to best answer questions about it like http://www.lee-mac.com/copyblock.html.

    See also: https://www.cadtutor.net/forum/topic...ns-to-color-2/

Similar Threads

  1. BLOCKS, ATTDEF, AND SCALES...
    By gisdude in forum CAD Management - General
    Replies: 2
    Last Post: 2015-05-18, 04:24 PM
  2. Replies: 1
    Last Post: 2014-08-08, 05:20 PM
  3. Fields in ttl blk connected to SSM
    By cadman_meg in forum AutoCAD Fields
    Replies: 3
    Last Post: 2008-02-14, 04:33 PM
  4. Option to Skip Update for All Tables
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2007-06-21, 04:48 PM
  5. Out of Date Table: Update All / Skip Update
    By .chad in forum ACA Wish List
    Replies: 2
    Last Post: 2007-06-08, 01:33 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •