Jump to content

Converting fields to text in attributes


Recommended Posts

Posted

Hello. I use tons of fields in attributes for areas, levels etc. But, our consultants confuses of this, so I use a lisp R-FIELDS (you can find it if google). It works perfect but only for model space and only for attributes and text. I insert xrefed drawings and it creates blocks which I want to remain blocks. But R-FIELDS lisp do not work in blocks and attributes in these blocks remains with fields. Is there way to add somethig to R-fields to works in blocks? Or is there lisp working in way I want. Thanks.

Posted

Untested:

(vl-load-com)

(defun c:RemFields  (/ ss remObject remInsert BlocksDone remText remXRef CurrDocName)
 (if (and (or (progn (prompt "\nSelect objects to remove field-codes from,")
                     (prompt "\nor press Enter to select everything.")
                     (ssget '((0 . "INSERT.TEXT,MTEXT"))))
              (ssget "_X" '((0 . "INSERT.TEXT,MTEXT"))))
          (setq ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))))
   (progn
     (defun remObject  (eo / oName)
       (cond ((wcmatch (set oName (vla-get-ObjectName eo)) "AcDbBlockReference") (remInsert eo))
             ((wcmatch oName "AcDbText,AcDbMText") (remText eo))))
     (defun remInsert  (eo / bo doc bName)
       (foreach ao (vlax-get eo 'GetAttributes) (remText ao))
       (if (and (not (member (setq bName (strcat CurrDocName (vla-get-EffectiveName eo))) BlocksDone))
                (setq bo (vla-Item (vla-get-Blocks (vla-get-Document eo)))))
         (progn (if (= (vla-get-IsXRef bo) :vlax-true)
                  (progn (remDBX (vla-get-Path bo)) (vla-Reload bo))
                  (vlax-for io bo (remObject io)))
                (setq BlocksDone (cons bName BlocksDone)))))
     (defun remText (to) (vl-catch-all-apply 'vla-put-TextString (list to (vla-get-TextString to))))
     (defun remXRef  (path / dbx doc acver CurrDocName)
       (if (setq dbx (vla-getinterfaceobject
                       (vlax-get-acad-object)
                       (cond ((< (setq acver (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument")
                             (t (strcat "ObjectDBX.AxDbDocument." (itoa acver))))))
         (progn
           (if (not (vl-catch-all-error-p (setq doc (vl-catch-all-apply 'vla-open (list dbx path))))))
           (progn (setq CurrDocName (vla-get-Name doc)
                        CurrDocName (strcat (substr CurrDocName 1 (- (strlen CurrDocName) 4)) "|"))
                  (vlax-for bo (vla-get-Blocks doc) (cond ((= (vla-isLayout bo) : vlax-true) (remObject bo))))
                  (vl-catch-all-apply 'vla-Save (list doc))
                  (vlax-release-object doc))
           (vlax-release-object dbx))))
     (setq CurrDocName "")
     (vlax-for eo ss (remObject eo))
     (vla-Delete ss)))
 (princ))

The principle is to step through a selection (or all entities in DWG if no selection). Then if a block reference is encountered, step through all its attributes, then check if its definition is an xref: If xref, then open the DWG file through ObjectDBX and perform the same on all entities inside its layouts (including Model Space), save and reload. If not an XRef then step through all internal entities of block and perform the same on them.

Posted

Thank you Irneb for the quick replay. I couldn't manage execute the lisp. And if I have understood the description - it changes and the xrefed files, but I don't want to change them - only remove fields of blocks created with insertion of xrefed files (I will try to remove this option but I'm not sure)

Posted

You're welcome, hope it actually does the job properly.

... only remove fields of blocks created with insertion of xrefed files (I will try to remove this option but I'm not sure)

I'm not sure I follow. Blocks "created" with insertion of xref are in fact the blocks coming from the xreffed-in DWG file. You can only change them in that file, not the current one (at least not permanently).

 

If you simply want to omit any form of xref work, then change the defun remXRef to something like this:

      (defun remXRef  (path) (princ))

Basically just doing nothing. That way It would still be able to work on attributes linked to the xref (though that's not an easy thing to actually create and I'm not sure you have such).

 

If you mean you want to "insert" the xrefs as normal blocks, I'm assuming you're referring to binding them first (either the insert / bind option)? In that case the xref changes to become a normal block contained inside the current drawing - thus the remXRef function would not even run for these.

Posted (edited)

Yes, I mean bind them but with "insert" option. Sorry confusing you. And I have confused me - the path of xref is disappeares in fact with "insert". Even that - I will remove changing xrefed files feature, I will killing fields with lisp even if I not bind xrefed files.

And thanks again, I will check again the lisp to try to get it works.

Edited by sevdo2000
Posted

Sorry, but I couldn't manage repair and execute the lisp :(.

Posted

Could you post a sample DWG I can try to work from? I'd have to debug it as I've not tested it yet.

Posted (edited)

Sorry for dellay,

I make a drawing with a sample block with attribute block and mtext with fields in it, and attribute with fields outside of block. There is an attribute block with fields in layout. With r-fields lisp I can convert only fields in model space outside of blocks.

sample.dwg

Edited by sevdo2000
Posted

there are a few mistakes (typos). i fix them but still something is wrong:

(defun c:RemFields  (/ ss remObject remInsert BlocksDone remText remXRef CurrDocName)
 (if
   (and
     (or
       (progn
         (prompt "\nSelect objects to remove field-codes from,")
         (prompt "\nor press Enter to select everything.")
         (ssget '((0 . "INSERT.TEXT,MTEXT")))
       )
       (ssget "_X" '((0 . "INSERT.TEXT,MTEXT")))
     )
     (setq ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
   )
   (progn
     (defun remObject  (eo / oName)
       (cond
         ( (wcmatch (set[color=red]q[/color] oName (vla-get-ObjectName eo)) "AcDbBlockReference") (remInsert eo))
         ( (wcmatch oName "AcDbText,AcDbMText") (remText eo))
       )
     )
     (defun remInsert  (eo / bo doc bName)
       (foreach ao (vlax-get eo 'GetAttributes) (remText ao))
       (if
         (and
           (not
             (member (setq bName (strcat CurrDocName (vla-get-EffectiveName eo))) BlocksDone)
           )
           (setq bo (vla-Item (vla-get-Blocks (vla-get-Document eo))))
         )
         (progn
           (if (= (vla-get-IsXRef bo) :vlax-true)
             (progn
               (remDBX (vla-get-Path bo))
               (vla-Reload bo)
             )
             (vlax-for io bo (remObject io))
           )
           (setq BlocksDone (cons bName BlocksDone))
         )
       )
     )
     (defun remText (to) (vl-catch-all-apply 'vla-put-TextString (list to (vla-get-TextString to))))
     (defun [color=red]remDBX[/color]  (path / dbx doc acver CurrDocName)
       (if
         (setq dbx
           (vla-getinterfaceobject
             (vlax-get-acad-object)
             (cond
               ( (< (setq acver (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" )
               ( T (strcat "ObjectDBX.AxDbDocument." (itoa acver)) )
             )
           )
         )
         (progn
           (if
             (not
               (vl-catch-all-error-p
                 (setq doc (vl-catch-all-apply 'vla-open (list dbx path)))
               )
             ) [color=red];;; )[/color]
             (progn
               (setq CurrDocName (vla-get-Name doc)
                     CurrDocName (strcat (substr CurrDocName 1 (- (strlen CurrDocName) 4)) "|")
               )
               (vlax-for bo (vla-get-Blocks doc) (cond ((= (vla-isLayout bo) : vlax-true) (remObject bo))))
               (vl-catch-all-apply 'vla-Save (list doc))
               (vlax-release-object doc)
             )
             (vlax-release-object dbx)
           )
         )
       )
     )
     (setq CurrDocName "")
     (vlax-for eo ss (remObject eo))
     (vla-Delete ss)
   )
 )
 (princ)
)

k.

Posted

Actually just realized I've done something like this before. Mind was slipping :oops:

 

Here's an old code of mine which removes fields from all text-like entities:

http://forums.augi.com/showthread.php?72534-Convert-Field-to-Text-within-Block-Globally&p=1093075&viewfull=1#post1093075

 

And I realize why my code below doesn't work - you need to change the text contents to something else, and then back to what it displayed. Else for some reason ACad doesn't remove the field itself.

Posted

Thank you irneb, the lisp works perfect, exept the option to convert fields in attribute blocks in blocks.

Posted

just my old code. Converts a field still in the tables

(defun C:CFT ()(ConvField->Text t))
(defun C:CFTAll ()(ConvField->Text nil))
(defun C:CFTSEL( / *error* Doc ss CountField)
  (vl-load-com)  
 (defun *error* (msg)(princ msg)(vla-endundomark doc)(princ))
 (setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark Doc)
 (if (setq ss (ssget "_:L"))
   (progn
     (setq CountField 0)
    (foreach obj (mapcar (function vlax-ename->vla-object)
            (vl-remove-if (function listp)
	      (mapcar (function cadr) (ssnamex ss))))
      (setq CountField (ClearField Obj CountField))
      )
     (princ "\nConverting Field in ")(princ CountField)
     (princ " text's")
     )
   )
(vla-endundomark Doc)
(command "_.Regenall")  
 )
(defun ClearField ( Obj CountField / txtstr att )
 (cond
       ((and (vlax-write-enabled-p Obj)
	 (= (vla-get-ObjectName obj) "AcDbBlockReference")
	 (= (vla-get-HasAttributes obj) :vlax-true)
    ) ;_ end of and
  (foreach att 	(append (vlax-invoke obj 'Getattributes)
                               (vlax-invoke obj 'Getconstantattributes)
                               )
           (setq txtstr (vla-get-Textstring att))
    (vla-put-Textstring att "")
    (vla-put-Textstring att txtstr)
    (setq CountField (1+ CountField))
  ) ;_ end of foreach
)
((and (vlax-write-enabled-p Obj)
	 (vlax-property-available-p Obj 'TextString)
    ) ;_ end of and
    (setq txtstr (vla-get-Textstring Obj))
    (vla-put-Textstring Obj "")
    (vla-put-Textstring Obj txtstr)
    (setq CountField (1+ CountField))
)
       ((and (vlax-write-enabled-p Obj) ;_Table
             (eq (vla-get-ObjectName Obj) "AcDbTable")
             )
        (and (vlax-property-available-p Obj 'RegenerateTableSuppressed)
               (vla-put-RegenerateTableSuppressed Obj :vlax-true)
             )
        (VL-CATCH-ALL-APPLY 
        '(lambda (col row / i j)
           (setq i '-1)
           (repeat col
             (setq i (1+ i) j '-1)
             (repeat row
               (setq j (1+ j))
               (vla-SetText Obj j i (vla-GetText Obj j i))
               (setq CountField (1+ CountField))
               )
             )
           )
        (list
          (vla-get-Columns Obj)
          (vla-get-Rows Obj)
          )
          )
        (and (vlax-property-available-p Obj 'RegenerateTableSuppressed)
               (vla-put-RegenerateTableSuppressed Obj :vlax-false)
             )
        )
       (t nil)
       )
 CountField
 )
(defun ConvField->Text ( Ask / Doc *error* ClearFieldInAllObjects
      )
;;; t - Ask user nil - convert
;;; Как все поля чертежа сразу преобразовать в текст?
;;; Convert Field to Text
;;; Posted Vladimir Azarko (VVA)
;;; http://forum.dwg.ru/showthread.php?t=20190&page=2
;;; http://forum.dwg.ru/showthread.php?t=20190
 (vl-load-com)  
 (defun *error* (msg)(princ msg)
  (mip:layer-status-restore)
  (vla-endundomark doc)(princ)
 )
(defun loc:msg-yes-no ( title message / WScript ret)
(setq WScript (vlax-get-or-create-object "WScript.Shell"))
(setq ret (vlax-invoke-method WScript "Popup" message "0" title (+ 4 48)))
(vlax-release-object WScript)
(= ret 6)  
)

(defun ClearFieldInAllObjects (Doc / txtstr tmp txt count CountField)
 (setq  CountField 0)  
 (vlax-for Blk	(vla-get-Blocks Doc)
   (if	(equal (vla-get-IsXref Blk) :vlax-false) ;;;kpbIc http://forum.dwg.ru/showpost.php?p=396910&postcount=30
     (progn
(setq count 0
      txt (strcat "Changed " (vla-get-name Blk))
      )
(grtext -1 txt)
;;;        (terpri)(princ "=================== ")(princ txt)
     (if (not (wcmatch (vla-get-name Blk) "`*T*")) ;_exclude table
     (vlax-for	Obj Blk
(setq count (1+ count))
(if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count))))
       (setq CountField (ClearField Obj CountField))
     ) ;_ end of vlax-for
       )
     )
   ) ;_ end of if
 ) ;_ end of vlax-for
(vl-cmdf "_redrawall")
CountField 
)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(mip:layer-status-save)(vla-startundomark Doc)
(if (or (not Ask )
 (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
   (loc:msg-yes-no "Внимание"
     "Все поля будут преобразованы в текст !!!\nПродолжить?"
     )
   (loc:msg-yes-no "Attension"
     "All fields will be transformed to the text!!!\nto Continue?"
     )
   )
 )
(progn
  (princ "\nConverting Field in ")
  (princ (ClearFieldInAllObjects Doc))
  (princ " text's")
  )
  (princ)
)
(mip:layer-status-restore)(vla-endundomark Doc)
(command "_.Regenall")  
(princ)
)

(defun mip:layer-status-restore	()
 (foreach item	*MIP_LAYER_LST*
   (if	(not (vlax-erased-p (car item)))
     (vl-catch-all-apply
'(lambda ()
   (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
   (vla-put-freeze
     (car item)
     (cdr (assoc "freeze" (cdr item)))
   ) ;_ end of vla-put-freeze
 ) ;_ end of lambda
     ) ;_ end of vl-catch-all-apply
   ) ;_ end of if
 ) ;_ end of foreach
 (setq *MIP_LAYER_LST* nil)
) ;_ end of defun
(defun mip:layer-status-save ()
 (setq *MIP_LAYER_LST* nil)
 (vlax-for item (vla-get-layers
	   (vla-get-activedocument (vlax-get-acad-object))
	 ) ;_ end of vla-get-layers
   (setq *MIP_LAYER_LST*
   (cons (list item
	       (cons "freeze" (vla-get-freeze item))
	       (cons "lock" (vla-get-lock item))
	 ) ;_ end of cons
	 *MIP_LAYER_LST*
   ) ;_ end of cons
   ) ;_ end of setq
   (vla-put-lock item :vlax-false)
   (if	(= (vla-get-freeze item) :vlax-true)
     (vl-catch-all-apply
'(lambda () (vla-put-freeze item :vlax-false))
     ) ;_ end of vl-catch-all-apply
   ) ;_ end of if
 ) ;_ end of vlax-for
) ;_ end of defun

The Russian-language forum at Edward spied another idea to transform the field in the text (remove dictionary "ACAD_FIELD"), but has not been able to test it fully in all primitives

(vl-load-com)
(defun C:field-to-text ()
 (if
   (and
     (setq txt-nabor (ssget '((0 . "mtext,insert"))))
     (setq txt-nabor (mapcar 'vlax-ename->vla-object
		      (vl-remove-if
			'listp
			(mapcar	'cadr
				(ssnamex txt-nabor)
			)
		      )
	      )
     )
   )

    (mapcar
      '(lambda	(x / dict)
  (cond
    (
     (and
       (= (vla-get-objectname x) "AcDbMText")
       (= (vla-get-HasExtensionDictionary x) :vlax-true)
     )
     (vlax-for item (setq dict (vla-GetExtensionDictionary x))
       (if
	 (= (vla-get-name item) "ACAD_FIELD")
	  (progn
	    (vla-remove dict "ACAD_FIELD")
	    (vla-put-textstring
	      x
	      (vl-string-trim "%<>" (vla-get-textstring x))
	    )
	  )
       )
     )
    )
    (
     (= (vla-get-objectname x) "AcDbBlockReference")
     (vlax-for item2 (vla-item (vla-get-blocks
				 (vla-get-ActiveDocument
				   (vlax-get-acad-object)
				 )
			       )
			       (vla-get-name x)
		     )
       (if
	 (and
	   (= (vla-get-objectname item2) "AcDbMText")
	   (= (vla-get-HasExtensionDictionary item2) :vlax-true)
	 )
	  (vlax-for item3
		    (setq dict (vla-GetExtensionDictionary item2))

	    (if
	      (= (vla-get-name item3) "ACAD_FIELD")
	       (progn
		 (vla-remove dict "ACAD_FIELD")
		 (vla-put-textstring
		   item2
		   (vl-string-trim
		     "%<>"
		     (vla-get-textstring item2)
		   )
		 )
	       )
	    )
	  )
       )
     )
    )
  )
)
      txt-nabor
    )
 )
 (princ)
)

  • Like 1
Posted

Thanks VVA. I know Russian a little. The first one is a good, very good lisp, kills everything with fields in all primitives. There is a little problem - I have m² sigh in attribute block for square surface, but "²" sigh apperas like "?" after using this lisp - but it still very good for my need. Thanks again

P.S. I'm not sure but I think it's something wrong with ASCII - UniCod ... ?

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...