Wipe Block Attributes

Anonymous · ‎12-12-2016

I have a few hundred dwg's that I'm going to convert to microstation files. The problem is that the AutoCAD files have a small block that looks like it has been burst when the conversion is completed. Is there a way to delete all of the attributes out of the block and replace just one with the full text string so it shows correctly when converted? I don't need the references anymore and the numbers shown in the drawing are final. I think this can be done with a script using -attedit but I'm not quite sure what I'm doing.

patrick_35 · ‎12-12-2016

Hi

Test with a directory example. It's work with ObjectDbx and save the result.

@+

Les Lisps de Patrick_35

Anonymous · ‎12-14-2016

This would work well for me if I could specify the one TAG I wanted to clear, namely "OBJECT"

patrick_35 · ‎12-14-2016

Hi

Replace

		  (foreach att (vlax-invoke obj 'getattributes)
		    (setq txt (cdr (assoc 1 (entget (vlax-vla-object->ename att)))))
		    (setq new (vla-addtext bl txt (vla-get-insertionpoint att) (vla-get-height att)))
		    (mapcar '(lambda(x)(vlax-put new x (vlax-get att x))) '(alignment backward color entitytransparency layer linetype linetypescale lineweight material normal obliqueangle rotation scalefactor stylename thickness upsidedown visible))
		    (vla-delete att)
		  )

With

		  (foreach att (vlax-invoke obj 'getattributes)
		    (and (vl-position (vla-get-tagstring att) '("OBJECT"))
		      (setq txt (cdr (assoc 1 (entget (vlax-vla-object->ename att)))))
		      (setq new (vla-addtext bl txt (vla-get-insertionpoint att) (vla-get-height att)))
		      (mapcar '(lambda(x)(vlax-put new x (vlax-get att x))) '(alignment backward color entitytransparency layer linetype linetypescale lineweight material normal obliqueangle rotation scalefactor stylename thickness upsidedown visible))
		      (vla-delete att)
		    )
		  )

@+

Les Lisps de Patrick_35

Anonymous · ‎12-15-2016

Awesome Patrick, It's very fast and does the job perfectly with very little fuss. I'm always amazed at how any programming problem can be solved even in my little world using plain old Autolisp. This would be such tedious job to do manually. I have my own lisp to clear that tag in existing dwgs but then you add some more blocks and they bring that default value back into the drawing. This will fix that problem too, thank you very much!

patrick_35 · ‎12-15-2016

You're welcomme.

We can do everything or almost with vlisp. Only the imagination is the limit.
There are only two things that have stood up for the moment. Freeze layers in viewport and a multiple selection of files (even though I had found how to do with Window's XP)

@+

Les Lisps de Patrick_35

Anonymous · ‎12-15-2016

I use this lisp for viewports. Its my own version. You double click into the viewport and pick something on the layer you want to freeze and it freezes it for that viewport only. In model space it freezes the layer there. It gives you the option to make another layer current if the layer you want to freeze is current. I'm still having problems with clearing my object layer it works for the first time sometimes. It runs right through the folder without reporting any errors but fails to clear the Object TAG. I have put the code under the following program and will attach a block for you to try.

(defun c:fzlay ()
    (graphscr)
    (setq cmd (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (setq b2 (entget (car (entsel "\nSelect Layer To Freeze.")))
          l2 (cdr (assoc 8 b2))
          cl (getvar "clayer"))
    (if (= cl l2)
        (progn
            (princ "\nCurrent Layer.....Cannot Freeze !")
            (setq nl2 (entget (car (entsel "\nSelect a New Current Layer.")))
                  nl (cdr (assoc 8 nl2)))
            (command "LAYER" "S" nl "")
        )
    )
    (if (= (getvar "tilemode") 1)
        (command "layer" "FREEZE" l2 "" )
        (command "vplayer" "f" l2 "c" "")
   )
   (princ "\nLayer ")
   (princ l2)
   (princ " Frozen\n")
   (princ)
   (setvar "cmdecho" cmd)
)

***************

(defun c:attxt(/ att ava bl dbx def express fic lay lst new obj rep tot txt ver
       msgbox dirbox ouvrir_dessin_dbx)

;;;---------------------------------------------------------------
;;;
;;; Choix du répertoire
;;;
;;;---------------------------------------------------------------

(defun dirbox(txt / cdl rep)
    (if (setq cdl (vlax-create-object "Shell.Application"))
      (progn
   (and (setq rep (vlax-invoke cdl 'browseforfolder 0 txt 512 ""))
         (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
   )
   (vlax-release-object cdl)
      )
    )
    rep
)

;;;---------------------------------------------------------------
;;;
;;; Ouvrir un dessin via ObjectDbx
;;;
;;;---------------------------------------------------------------

(defun Ouvrir_dessin_dbx(dwg / dbx doc lan rel)
    (and (setq dwg (findfile dwg))
      (progn
   (vlax-for doc (vla-get-documents (vlax-get-acad-object))
      (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
        (setq dbx doc lan T)
      )
   )
   (and (not dbx)
      (setq dbx (vlax-create-object (if (< (setq rel (atoi (getvar "ACADVER"))) 16)
                      "ObjectDBX.AxDbDocument"
                      (strcat "ObjectDBX.AxDbDocument." (itoa rel))
                   )
            )
      )
      (vla-open dbx dwg)
   )
      )
    )
    (list dbx lan)
)

(vl-load-com)
(if (eval 'acet-ui-progress-done)
    (setq express T)
)
(if (setq rep (dirbox "Choose a directory"))
    (if (setq lst (vl-directory-files rep "*.dwg" 1))
      (foreach fic lst
   (if (setq dbx (ouvrir_dessin_dbx (strcat rep "/" fic)))
      (progn
        (setq ver nil
          tot 0
          ava 0
        )
        (vlax-for lay (vla-get-layers (car dbx))
          (and (eq (vla-get-lock lay) :vlax-true)
       (setq ver (cons lay ver))
       (vla-put-lock lay :vlax-false)
          )
        )
        (and express
          (vlax-for bl (vla-get-blocks (car dbx))
       (setq tot (+ tot (vla-get-count bl)))
          )
          (acet-ui-progress-init "" tot)
        )
        (princ (strcat "\n Work on " fic))(princ)
        (vlax-for bl (vla-get-blocks (car dbx))
          (vlax-for obj bl
       (and express
          (setq ava (1+ ava))
          (acet-ui-progress-safe ava)
       )
       (and (eq (vla-get-objectname obj) "AcDbBlockReference")
              (foreach att (vlax-invoke obj 'getattributes)
            (and (vl-position (vla-get-tagstring att) '("OBJECT"))
              (setq txt (cdr (assoc 1 (entget (vlax-vla-object->ename att)))))
              (setq new (vla-addtext bl txt (vla-get-insertionpoint att) (vla-get-height att)))
              (mapcar '(lambda(x)(vlax-put new x (vlax-get att x))) '(alignment backward color entitytransparency layer linetype linetypescale lineweight material normal obliqueangle rotation scalefactor stylename thickness upsidedown visible))
              (vla-delete att)
            )
          )
       )
          )
        )
        (foreach lay ver
          (vla-put-lock lay :vlax-true)
        )
        (and express
          (acet-ui-progress-done)
        )
        (or (cadr dbx)
          (progn
       (princ " ...Save")(princ)
       (vla-saveas (car dbx) (strcat rep "/" fic))
       (vlax-release-object (car dbx))
          )
        )
        (princ " ...OK")(princ)
      )
      (princ (strcat "\n Impossible de lire le fichier " fic))
   )
      )
      (msgbox "DUC" 64 (strcat "Pas de dessin dans " rep))
    )
)
(setq *error* s)
(princ)
)

Anonymous · ‎12-15-2016

Here are a few of the blocks

patrick_35 · ‎12-15-2016

Thanks for the code, but it only works on the active viewport and in no case with ObjectDbx. I can read xdata, don't write viewport's xdata.

The lisp works on the blocks in the drawing, not on the blocks's definition.

To delete attribute's definition, replace

		(and (eq (vla-get-objectname obj) "AcDbBlockReference")
		  (foreach att (vlax-invoke obj 'getattributes)
		    (and (vl-position (vla-get-tagstring att) '("OBJECT"))
		      (setq txt (cdr (assoc 1 (entget (vlax-vla-object->ename att)))))
		      (setq new (vla-addtext bl txt (vla-get-insertionpoint att) (vla-get-height att)))
		      (mapcar '(lambda(x)(vlax-put new x (vlax-get att x))) '(alignment backward color entitytransparency layer linetype linetypescale lineweight material normal obliqueangle rotation scalefactor stylename thickness upsidedown visible))
		      (vla-delete att)
		    )
		  )
		)

With

		(and (eq (vla-get-objectname obj) "AcDbAttributeDefinition")
		     (vl-position (vla-get-tagstring obj) '("OBJECT"))
		  (vla-delete obj)
		)

@+

Les Lisps de Patrick_35

Anonymous · ‎12-15-2016

Unfortunately now its deleting the TAG itself instead of just the value in the tag.

patrick_35 · ‎12-15-2016

Ok

Replace

(vla-delete obj)

With

(vla-put-textstring obj "")

@+

Les Lisps de Patrick_35

Anonymous · ‎12-15-2016

You are so clever! I wish I knew Vlisp as well as Autolisp but I just can't bring myself to learn yet another computer language I already more or less know 7 of them. The program now works perfectly thank you! I can't find the way to mark your last post as a solution though.

patrick_35 · ‎12-20-2016

Hi

I was like you at first, reluctant to learn another language, but little by little ...

To approve a message, you can not because you are not at the origin of the message, except for a moderator or an expert.

The main thing is that the lisp satisfies you.

@+

Les Lisps de Patrick_35

Community

Wipe Block Attributes

Wipe Block Attributes

Wipe Block Attributes