Solved! Go to Solution.
Solved by john.uhden. Go to Solution.
1. OPEN BLOCK EDITOR.
2. CREATE NEW ATTRIBUTE.
3. CLOSE BLOCK.
4. USE ATTSYNC COMMAND AND SELECT BLOCK.
5. AGAIN OPEN BLOCK.
6. REMOVE ATTRIBUTE WITH DELETE COMMAND.
7.CLOSE BLOCK.
8.AGAIN USE ATTSYNC COMMAND.
9. NO ATTRIBUTES IN UR BLOCK.
HOPE THIS WORKS FOR YOU.
GOOD DAY.
Here ya go, complete with error and undo controls.
;; ATTDEL.LSP for d2cad by John F. Uhden 01-17-17 ;; Just select inserts. Those without attributes will be filtered out.
;; Actually, you can pick anything, but only inserts with attributes
;; will be selected.
;; Attributes on locked layers will report errors, but
;; the program will continue.
;; It does not change any block definition, but you could copy the
;; emasculated block insertions.
;; (defun C:ATTDEL ( / *error* err vars ss i obj atts m n) (vl-load-com) (defun *error* (err) (mapcar '(lambda (x)(setvar (car x)(cdr x))) vars) (vla-endundomark *doc*) (cond ((not err)) ((wcmatch (strcase err) "*CANCEL*,*QUIT*")) (1 (princ (strcat "\nERROR: " err))) ) (princ) ) (or *acad* (setq *acad* (vlax-get-acad-object))) (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*))) (vla-endundomark *doc*) (vla-startundomark *doc*) (setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho"))) (mapcar '(lambda (x)(setvar (car x) 0)) vars) (command "_.expert" (getvar "expert")) ;; dummy command (and (setq ss (ssget '((0 . "INSERT")(66 . 1)))) (setq i (sslength ss) n 0 m 0) (while (> i 0) (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i))))) (setq atts (vla-getattributes obj)) (setq atts (vlax-variant-value atts)) (foreach att (vlax-safearray->list atts) (setq m (1+ m)) (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-delete (list att)))) (princ (strcat "\nERROR: " (vl-catch-all-error-message err))) (setq n (1+ n)) ) ) ) ) (princ (strcat "\nDeleted " (itoa n) "/" (itoa m) " attributes.")) (*error* nil) )
John F. Uhden
Fantastic LISP file.
This worked great!!!
Added to our list to use for now on!
Thanks!
Hello @john.uhden ! I know the post is a bit old but I've tried this lisp ATTDEL but it doesn't really work for me (autocad 2006).
When I run the lisp it works at first, but when I open the block editor, attributes definitionS are still there....
and if I do ATTSYNC on this bloc old attributes re-appear again.
Someone can tell me what I am doing wrong plz🙏🙏🙏🙏
Or is there a way to delete all attributes massively in one time of a full library of blocks.
Thanks U in advance
Cheers
John F. Uhden
@Dany.jee wrote:
Or is there a way to delete all attributes massively in one time of a full library of blocks.
Thanks U in advance
Cheers
(defun c:removeBlockAttributes nil (removeBlockAttributes))
(defun removeBlockAttributes ( / file f lst dcl_id sel remove_Attribute getblocks string_to_list)
(defun remove_Attribute (blockname)
(setq acad (vlax-get-acad-object) doc (vla-get-activedocument acad))
(cond
((tblsearch "BLOCK" blockname)
(setq blk (vla-item (vla-get-blocks doc) blockname))
(vlax-for item blk
(if (= (vlax-get item 'ObjectName) "AcDbAttributeDefinition")(vla-delete item))
)
)
(T (princ (strcat "\nBlock with name " blockname " don't exist in this drawing >")))
)
)
(defun getblocks (/ adoc name lst)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for blk (vla-get-blocks adoc)
;; Exclude model and paper spaces, xref and anonymus blocks
(if (and (equal (vla-get-IsLayout blk) :vlax-false)
(equal (vla-get-IsXref blk) :vlax-false)
(/= (substr (vla-get-Name blk) 1 1) "*"))
(setq lst (cons (vla-get-Name blk) lst))
)
)
lst
)
(defun string_to_list ( str del / pos )
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos) (string_to_list (substr str (+ pos 1 (strlen del))) del))
(list str)
)
)
(setq file (vl-filename-mktemp "blocks.dcl"))
(setq f (open file "w"))
(write-line "test: dialog {:row {:list_box {label = \"Remove attributes from block\"; key = \"blocks\";fixed_width = true;width = 20;height = 12;multiple_select = true; } } ok_cancel; }" f)
(close f)
(setq lst (getblocks))
(setq dcl_id (load_dialog file))
(if (not (new_dialog "test" dcl_id)) (exit))
(start_list "blocks" 3)
(mapcar 'add_list lst)
(end_list)
(action_tile "accept" "(setq sel (get_tile \"blocks\"))(done_dialog)")
(start_dialog)
(done_dialog dcl_id)
(unload_dialog dcl_id)
(cond
((and sel)
(setq sel (mapcar 'atoi (string_to_list sel " ")))
(foreach index sel (remove_Attribute (nth index lst)))
)
)
(princ "\nDone!")
)
Miljenko Hatlak
@hak_vz THANK YOU very much. It's working so well.
Maybe you coul help me with the next part.. Now I've written a code to add new attributes .
It's work well when I apply it on ONE block.. but it doesn't work if I selected several blocks: in this case the first block is correct but others the first 8 attributes are added...
and I can't figure why😓
(defun c:KTEST1 ( / ss i blk blks def )
(and
(setq ss (ssget '((0 . "INSERT"))))
(setq i (sslength ss))
(while (> i 0)
(setq blk (cdr (assoc 2 (entget (ssname ss (setq i (1- i)))))))
(if (not (vl-position blk blks))(setq blks (cons blk blks)))
)
)
(foreach blk blks
;------------ATTRIBUT 01 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt (vlax-3D-point 0 +500))
(setq natt (vla-addattribute def 110 acattributemodepreset "ATTRIBUT01" pt "ATTRIBUT01" "xxxx"))
(vla-put-Color natt 250)
(vlax-put-property natt 'alignment acAlignmentCenter)
(vlax-put-property natt 'textalignmentpoint pt)
;------------ATTRIBUT 02 ---------------------------------------------------
(setq pt2 (vlax-3D-point 0 +350))
(setq natt2 (vla-addattribute def 110 acattributemodepreset "ATTRIBUT02" pt2 "ATTRIBUT02" "xxxx"))
(vla-put-Color natt2 250)
(vlax-put-property natt2 'alignment acAlignmentCenter)
(vlax-put-property natt2 'textalignmentpoint pt2)
;------------ATTRIBUT 03 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt3 (vlax-3D-point 0 -150))
(setq natt3 (vla-addattribute def 110 acattributemodepreset "ATTRIBUT03" pt3 "ATTRIBUT03" "xxxx"))
(vla-put-Color natt3 250)
(vlax-put-property natt3 'alignment acAlignmentCenter)
(vlax-put-property natt3 'textalignmentpoint pt3)
;------------ATTRIBUT 04 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt4 (vlax-3D-point 0 -300))
(setq natt4 (vla-addattribute def 110 acattributemodepreset "ATTRIBUT04" pt4 "ATTRIBUT04" "xxxx"))
(vla-put-Color natt4 250)
(vlax-put-property natt4 'alignment acAlignmentCenter)
(vlax-put-property natt4 'textalignmentpoint pt4)
;------------ATTRIBUT 05 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt5 (vlax-3D-point 0 -450))
(setq natt5 (vla-addattribute def 110 acattributemodepreset "ATTRIBUT05" pt5 "ATTRIBUT05" "xxxx"))
(vla-put-Color natt5 250)
(vlax-put-property natt5 'alignment acAlignmentCenter)
(vlax-put-property natt5 'textalignmentpoint pt5)
;------------ATTRIBUT 06 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt6 (vlax-3D-point 0 -600))
(setq natt6 (vla-addattribute def 110 acattributemodepreset "ATTRIBUT06" pt6 "ATTRIBUT06" "xxxx"))
(vla-put-Color natt6 250)
(vlax-put-property natt6 'alignment acAlignmentCenter)
(vlax-put-property natt6 'textalignmentpoint pt6)
;------------ATTRIBUT 07 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt7 (vlax-3D-point 0 -750))
(setq natt7 (vla-addattribute def 110 acattributemodepreset "ATTRIBUT07" pt7 "ATTRIBUT07" "xxxx"))
(vla-put-Color natt7 250)
(vlax-put-property natt7 'alignment acAlignmentCenter)
(vlax-put-property natt7 'textalignmentpoint pt7)
;------------ATTRIBUT 08 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt8 (vlax-3D-point 0 -900))
(setq natt8 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT08" pt8 "ATTRIBUT08" "xxxx"))
(vla-put-Color natt8 250)
(vlax-put-property natt8 'alignment acAlignmentCenter)
(vlax-put-property natt8 'textalignmentpoint pt8))
;------------ATTRIBUT 09 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt9 (vlax-3D-point 0 -1050))
(setq natt9 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT09" pt9 "ATTRIBUT09" "xxxx"))
(vla-put-Color natt9 250)
(vlax-put-property natt9 'alignment acAlignmentCenter)
(vlax-put-property natt9 'textalignmentpoint pt9)
;------------ATTRIBUT 10 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt10 (vlax-3D-point 0 -1200))
(setq natt10 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT10" pt10 "ATTRIBUT10" "xxxx"))
(vla-put-Color natt10 250)
(vlax-put-property natt10 'alignment acAlignmentCenter)
(vlax-put-property natt10 'textalignmentpoint pt10)
;------------ATTRIBUT 11 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt11 (vlax-3D-point 0 -1350))
(setq natt11 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT11" pt11 "ATTRIBUT11" "xxxx"))
(vla-put-Color natt11 250)
(vlax-put-property natt11 'alignment acAlignmentCenter)
(vlax-put-property natt11 'textalignmentpoint pt11)
;------------ATTRIBUT 12 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt12 (vlax-3D-point 0 -1500))
(setq natt12 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT12" pt12 "ATTRIBUT12" "xxxx"))
(vla-put-Color natt12 250)
(vlax-put-property natt12 'alignment acAlignmentCenter)
(vlax-put-property natt12 'textalignmentpoint pt12)
;------------ATTRIBUT 13 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt13 (vlax-3D-point 0 -1650))
(setq natt13 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT13" pt13 "ATTRIBUT13" "xxxx"))
(vla-put-Color natt13 250)
(vlax-put-property natt13 'alignment acAlignmentCenter)
(vlax-put-property natt13 'textalignmentpoint pt13)
;------------ATTRIBUT 14 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt14 (vlax-3D-point 0 -1800))
(setq natt14 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT14" pt14 "ATTRIBUT14" "xxxx"))
(vla-put-Color natt14 250)
(vlax-put-property natt14 'alignment acAlignmentCenter)
(vlax-put-property natt14 'textalignmentpoint pt14)
;------------ATTRIBUT 15 ---------------------------------------------------
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt15 (vlax-3D-point 0 -1950))
(setq natt15 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT15" pt15 "ATTRIBUT15" "xxxx"))
(vla-put-Color natt15 250)
(vlax-put-property natt15 'alignment acAlignmentCenter)
(vlax-put-property natt15 'textalignmentpoint pt15)
(command "_.attsync" "_N" blk)
)
(princ)
)
(vl-load-com) (princ)R
PS: is someone new how to set the color bylayer, for now it s only black (vla-put-Color natt 250)
@Dany.jee hi,
you have an extra right parentheses at the finish, beside that it works.
color bylayer is 256
Moshe
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq pt15 (vlax-3D-point 0 -1950))
(setq natt15 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT15" pt15 "ATTRIBUT15" "xxxx"))
(vla-put-Color natt15 250)
(vlax-put-property natt15 'alignment acAlignmentCenter)
(vlax-put-property natt15 'textalignmentpoint pt15)
(command "_.attsync" "_N" blk)
; ) this is redundant
(princ)
)
(vl-load-com) (princ)R
@Dany.jee wrote:@Moshe-A thanks for the correction but I still have the same issue:
O
nly the first block is completed with 15 attributes and folowing block only have 8 attributes🤔
thats because the rest of the attributes (7) attributes are added to block as invisibile 😀
(setq natt15 (vla-addattribute def 110 acattributemodeinvisible "ATTRIBUT15" pt15 "ATTRIBUT15" "xxxx"))
Yes it's volontary.
But if you try the lisp you will see.. they are not only insivisble.. they aren't create, they didn't exist att all.
In the block editor the last attribute is 8th.
You can see here: the first bloc is correctly attribuated.. and for all the others it's look like not running the full lisp .
I was supposed to select all blocks and apply the lisp once for all, for now I need to apply it individualy.. Not cool when you have 500+ blocks in library😭😭😭