CAD Forum - Database of tips, tricks and utilities for AutoCAD, Inventor and other Autodesk products [www.cadforum.cz]
CZ | EN | DE
Login or
registration
  Visitors: 2645
RSS channel - CAD tips RSS tips
RSS discussions

Discussion Discussion forum

 

HelpCAD discussion

 
CAD Forum - Homepage CAD discussion forum - ask any CAD-related questions here, share your CAD knowledge on AutoCAD, Inventor, Revit and other Autodesk software with your peers from all over the world. To start a new topic, choose an appropriate forum.

Please abide by the rules of this forum.

How to post questions: register or login, go to the specific forum and click the NEW TOPIC button.
  FAQ FAQ  Forum Search   Events   Register Register  Login Login

The information that you provide in this form will make up your forum profile which can be viewed by other forum members. Your email address will only be visible by forum admin and moderators and will be used to send you Forum Notifications. To cancel your account, use the page Opt-out or contact webmaster@cadforum.cz.

Changes all the text color selected blk def.

 Post Reply Post Reply
Author
remcokoedoot View Drop Down
Newbie
Newbie


Joined: 16.Oct.2013
Location: Netherlands
Using: AutoCAD
Status: Offline
Points: 16
Post Options Post Options   Thanks (0) Thanks(0)   Quote remcokoedoot Quote  Post ReplyReply Direct Link To This Post Topic: Changes all the text color selected blk def.
    Posted: 19.Aug.2022 at 12:31
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
 
;;;   File Name: COLOR-TEXT-OBJECTS-IN-SELECTED-BLOCKS-TO-COLOR-2.LSP
;;;   Description:  Changes all the text in selected block definitions to color 2.
;;;   Will skip alfl XREF & XREF dependent blocks. 
;;;

(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)
            ; As long as we haven't reached the end of the block's defintion, get the data
            ; for each entity and change its color assignment to BYLAYER.
            (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)
)
(princ "\nCOLOR-TEXT-OBJECTS-IN-SELECTED-BLOCKS-TO-COLOR-2.LSP - AutoCAD lisp routine wijzigt in geselcteerde blocks de tekst kleur in geel. AutoCAD kleur 2.")
(princ "\nStart deze AutoCAD-trim-routine met AutoCAD commando: chtxtinselblockscolor2")
(princ)


Edited by remcokoedoot - 19.Aug.2022 at 12:36
With kind regards,

Remco Koedoot
Back to Top
remcokoedoot View Drop Down
Newbie
Newbie


Joined: 16.Oct.2013
Location: Netherlands
Using: AutoCAD
Status: Offline
Points: 16
Post Options Post Options   Thanks (0) Thanks(0)   Quote remcokoedoot Quote  Post ReplyReply Direct Link To This Post Posted: 24.Aug.2022 at 12:15
Can someone update the routine? This is a start. The problem is the subroutine.
With kind regards,

Remco Koedoot
Back to Top
Kent Cooper View Drop Down
Senior Member
Senior Member


Joined: 12.Mar.2013
Location: United States
Using: AutoCAD2019
Status: Offline
Points: 565
Post Options Post Options   Thanks (0) Thanks(0)   Quote Kent Cooper Quote  Post ReplyReply Direct Link To This Post Posted: 24.Aug.2022 at 17:03
And what is the problem with the sub-routine?
Back to Top
remcokoedoot View Drop Down
Newbie
Newbie


Joined: 16.Oct.2013
Location: Netherlands
Using: AutoCAD
Status: Offline
Points: 16
Post Options Post Options   Thanks (0) Thanks(0)   Quote remcokoedoot Quote  Post ReplyReply Direct Link To This Post Posted: 16.Sep.2022 at 09:40
This routine is especially useful for redefining pre-placed blocks with respect to the entity colors.
This routine can redefine all colors in a block.
Convert all entities in a block to a single color.
Without the user having to explode the block symbol.
The layer names of all entities in the block are not changed.
The routine changes the original definition of the block in the current drawing.
While using this routine, you will be prompted to indicate a color code for all entities of the selected block.
The user is prompted to select one or more blocks so that this routine then redefines all entities of the block to the specified color.
It would be nice if this only changes the color of the text elements and not of line elements.

; UPDATE-BLOCK-COLOR-CONTENTS.LSP
; UPDATE BLOCK COLOR LISP ROUTINE
; Deze routine is vooral nuttig om vooraf geplaatste blokken te herdefiniƫren met betrekking tot de entiteit kleuren.
; Deze routine kan alle kleuren in een block herdefiniƫren.
; Alle entiteiten in een blok omzetten naar een enkele kleur.
; Zonder dat de gebruiker het block-symbool moet exploderen.
; De namen van de lagen van alle entiteiten in het block worden niet gewijzigd.
; De routine verandert de oorspronkelijke definitie van het blok in de huidige tekening.
; Tijdens het gebruik van deze routine wordt gevraagd om een kleur code aan te geven voor alle entiteiten van het geselecteerde blok.
; De gebruiker wordt gevraagd om een of meerdere blokken te selecteren, zodat deze routine dan alle entiteiten van het blok aan de opgegeven kleur herdefinieert.

;INTERNAL ERROR HANDLER
(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

;(DEFUN C:UPDATE-BLOCK-COLOR (/ BLK CBL CBL2 C ACL ALY NLY NCL)

(graphscr)
(prompt "\nupdate-block-color.lsp - Versie 1.0")
(prompt "\nAutoCAD lisp routine voor het wijzigen van entiteiten in blokken in een te selecteren kleur.")
(prompt "\nDeze routine is vooral nuttig om vooraf geplaatste blokken te herdefiniƫren met betrekking tot de entiteit kleuren.")
(prompt "\nDeze routine kan alle kleuren in een block herdefiniƫren.")
(prompt "\nAlle entiteiten in een blok omzetten naar een enkele kleur.")
(prompt "\nZonder dat de gebruiker het block-symbool moet exploderen.")
(prompt "\nDe namen van de lagen van alle entiteiten in het block worden niet gewijzigd.")
(prompt "\nDe routine verandert de oorspronkelijke definitie van het blok in de huidige tekening.")
(prompt "\nTijdens het gebruik van deze routine wordt gevraagd om een kleur code aan te geven voor alle entiteiten van het geselecteerde blok.")
(prompt "\nDe gebruiker wordt gevraagd om een of meerdere blokken te selecteren, zodat deze routine dan alle entiteiten van het blok aan de opgegeven kleur herdefinieert.")

(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 0 | <BYBLOCK> ")
(princ "\n 1 | ROOD - RED ")
(princ "\n 2 | GEEL - YELLOW ")
(princ "\n 3 | GROEN - GREEN ")
(princ "\n 4 | CYAAN - CYAN ")
(princ "\n 5 | DONKER BLAUW - BLUE ")
(princ "\n 6 | PAARS - MAGENTA ")
(princ "\n 7 | WIT - White ")
(princ "\n 8...255 | -Varies- ")
(princ "\n 256 | <BYLAYER> ")
(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)
Wink;end UPDATE-BLOCK-COLOR

(princ "\nUPDATE-BLOCK-COLOR-CONTENTS.LSP - AutoCAD lisp routine voor het wijzigen van entiteiten in blokken in een te selecteren kleur.")
(princ "\nVersie 1.0. Remco Koedoot")
(princ "\nStart de kleur-in-block-routine met AutoCAD commando: update-block-color")
(princ "\nDeze routine is vooral nuttig om vooraf geplaatste blokken te herdefiniƫren met betrekking tot de entiteit kleuren.")
(princ "\nDeze routine kan alle kleuren in een block herdefiniƫren.")
(princ "\nAlle entiteiten in een blok omzetten naar een enkele kleur.")
(princ "\nZonder dat de gebruiker het block-symbool moet exploderen.")
(princ "\nDe namen van de lagen van alle entiteiten in het block worden niet gewijzigd.")
(princ "\nDe routine verandert de oorspronkelijke definitie van het blok in de huidige tekening.")
(princ "\nTijdens het gebruik van deze routine wordt gevraagd om een kleur code aan te geven voor alle entiteiten van het geselecteerde blok.")
(princ "\nDe gebruiker wordt gevraagd om een of meerdere blokken te selecteren, zodat deze routine dan alle entiteiten van het blok aan de opgegeven kleur herdefinieert.")
(princ)
With kind regards,

Remco Koedoot
Back to Top
remcokoedoot View Drop Down
Newbie
Newbie


Joined: 16.Oct.2013
Location: Netherlands
Using: AutoCAD
Status: Offline
Points: 16
Post Options Post Options   Thanks (0) Thanks(0)   Quote remcokoedoot Quote  Post ReplyReply Direct Link To This Post Posted: 16.Sep.2022 at 09:40
AutoCAD lisp routine for selecting and changing the color of text objects in AutoCAD color 2 yellow. But unfortunately not in selectable blocks.
This is an improvement point to also adjust the color of texts in blocks. And to combine with previous routines:

;;;; CHANGE-TEXT-OBJECTS-TO-COLOR-2-YELLOW-CONTENTS.LSP - AutoCAD lisp routine voor het selecteren en wijzigen van de kleur van text-objecten in AutoCAD kleur 2 geel
;;;; Versie 1.0
;;;; Revisie: 10-08-2022

(graphscr)
(setvar "cmdecho" 0)
(command "_undo" "_m")
(prompt "\nAutoCAD lisp routine voor het selecteren en wijzigen van de kleur van text-objecten in AutoCAD kleur 2 geel")
(setq eset
(ssget
(list
(cons -4 "<OR")
(cons 0 "ATTDEF")
(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)
(setvar "cmdecho" 1)
(princ)
(prompt "\nDe AutoCAD-selecteren-en-wijzigen-van-de-kleur-van-text-objecten-in-AutoCAD-kleur-2-geel-routine opdracht is beƫindigd, er zijn geen text-veld objecten meer geselecteerd.")
(princ)
(princ "\nCHANGE-TEXT-OBJECTS-TO-COLOR-2-YELLOW-CONTENTS.LSP - AutoCAD lisp routine voor het selecteren en wijzigen van de kleur van text-objecten in AutoCAD kleur 2 geel.")
(princ)
With kind regards,

Remco Koedoot
Back to Top
remcokoedoot View Drop Down
Newbie
Newbie


Joined: 16.Oct.2013
Location: Netherlands
Using: AutoCAD
Status: Offline
Points: 16
Post Options Post Options   Thanks (0) Thanks(0)   Quote remcokoedoot Quote  Post ReplyReply Direct Link To This Post Posted: 16.Sep.2022 at 09:41
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)
With kind regards,

Remco Koedoot
Back to Top

Related CAD tips:


 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down



This page was generated in 0,063 seconds.