Jump to content

Lee Mac Burst Upgraded - upgrade

VAC

By VAC
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

VAC Contributor

VAC

Posted
Posted

Hi,

it will be great to have a lisp that will change any selected fields (used in f.e. dyn.blocks, mtexts, attributes....) to simple text that will safe the field value but do not explode original block.

We use a lot of block with attributes with fields - it is OK - for us. But when we send our project to another user, that do not use Autocad, but another software, there are few incompatibilities, especially in fields. Usually it shows ####. Upgraded burst from Lee Mac is great, but explodes all blocks. If there is way, how to only change fields to non automatical text (fileds in attributes->simple text in attributes etc) and keep blocks, it will be great.

http://www.lee-mac.com/upgradedburst.html

Many thanks

VAC Contributor

VAC

Posted
  • Author
Posted

I do not undestand your answer - I do not found the solution on that url.

marko_ribar Veteran

marko_ribar

Posted
Posted

My suggestion was that he would unlikely approach to answering your request the way you are expecting... He very much favors using all entity types to describe and support DWG standard capabilities including FIELD entity types... If needed, why you don't create new separate LAYER and recreate new entity types (TEXT entities) placing them inside and filling them with data collected through inspection of problematic #### FIELD(S) and then if you want bind them (new LAYER) to perhaps some new BLOCK/XREF that would be child DWG of master referencing one you are inspecting...

BIGAL Grand Master

BIGAL

Posted
Posted

If you get the textstring of the attribute then put the textstring as the plain value the field value will be gone. 

 

Post a dwg with sample blocks

VAC Contributor

VAC

Posted
  • Author
Posted

Here is my sample. I want to convert left samples to right ones with lisp. I have a lot of other blocks, tables,mtexts,attruibutes with fields like that....

sample.dwg

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

Look, I've tried what you wanted...

But, something's wrong - recursion can't process evaluation of sub function (_getnestedfields ename)... I've tested that sub on basic entity that don't have FIELDS - like LINE in empty DWG, and also the same - recustion stack limit reached error...

I don't know what is wrong - I am pretty sure that sub function is written correctly...

Anyhoo, here is the code, so you can try debugging it on your own...

  

(defun c:replacefields2textsvalues ( / _getnestedfields _getmaintxtparentchild LM:popup ss i e fields l fieldx maintxtparentchild maintxtparent enx txt )

  (vl-load-com) ;;; load AciveX extensions (VLA functions) ;;; you can remove this line - it's only needed for LM:popup (sub function)...

  (defun _getnestedfields ( e / mainfoo enx r )

    (defun mainfoo ( enxxl / foo )

      (defun foo ( enx / enxx enxxl )
        (if (vl-some '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx)
          (setq enxx (entget (cdr (assoc (vl-some '(lambda ( x ) (if (and (= (type (cdr x)) 'ename) (/= (car x) 330)) (car x))) enx) enx))))
          (setq enxx nil)
        )
        (cond
          ( (equal (assoc 0 enx) (cons 0 "FIELD"))
            (setq r (cons enx r))
            (if enxx
              (setq enxxl (mapcar '(lambda ( x ) (entget (cdr x))) (vl-remove-if-not '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx)))
            )
          )
          ( enxx
            (setq enxxl (mapcar '(lambda ( x ) (entget (cdr x))) (vl-remove-if-not '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx)))
          )
        )
        enxxl
      )

      (if enxxl
        (mainfoo (apply 'append (mapcar '(lambda ( x ) (foo x)) enxxl)))
      )
    )

    (setq enx (entget e '("*")))
    (mainfoo (list enx))
    (if r
      (mapcar '(lambda ( x ) (cdr (assoc -1 x))) r)
    )
  )

  (defun _getmaintxtparentchild ( fieldx / enx enxx )
    (setq enx fieldx)
    (while (not (wcmatch (cdr (assoc 0 (entget (cdr (assoc 330 enx))))) "*ATT*,*TEXT"))
      (setq enx (cdr (assoc 330 enx)))
    )
    (setq enxx (cdr (assoc 330 enx)))
    (if enxx
      (list (cdr (assoc -1 enxx)) (cdr (assoc -1 enx)))
    )
  )

  ;; Popup  -  Lee Mac
  ;; A wrapper for the WSH popup method to display a message box prompting the user.
  ;; ttl - [str] Text to be displayed in the pop-up title bar
  ;; msg - [str] Text content of the message box
  ;; bit - [int] Bit-coded integer indicating icon & button appearance
  ;; Returns: [int] Integer indicating the button pressed to exit

  (defun LM:popup ( ttl msg bit / wsh rtn )
    (if (setq wsh (vlax-create-object "wscript.shell"))
      (progn
        (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit)))
        (vlax-release-object wsh)
        (if (not (vl-catch-all-error-p rtn)) rtn)
      )
    )
  )

  (if (ssget "_A" (list '(0 . "~VIEWPORT") '(60 . 0) (cons 410 (if (= (getvar 'cvport) 1) (getvar 'ctab) "Model"))))
    (progn
      (prompt "\nSelect objects on unlocked layer(s) - preferable is that you type here \"ALL\" in order to make operation working on all visible entities of current/active space/layout...")
      (if (setq ss (ssget "_:L"))
        (progn
          (repeat (setq i (sslength ss))
            (setq e (ssname ss (setq i (1- i))))
            (if (= (cdr (assoc 0 (entget e '("*")))) "FIELD")
              (setq fields (cons e fields))
              (if (setq l (_getnestedfields e))
                (setq fields (append fields l))
              )
            )
          )
          ;;; (princ fields) ;;; if you want to see if something was collected - (0 . "FIELD") enitites...
          (foreach field fields
            (if (assoc 330 (setq fieldx (entget field '("*"))))
              (progn
                (setq maintxtparentchild (_getmaintxtparentchild fieldx))
                (if (setq maintxtparent (car maintxtparentchild))
                  (progn
                    (setq enx (entget maintxtparent))

                    ;;; if first uncommented paragraphs works, then leave it - it's better IMHO... otherwise, try with ;;; part - uncomment it and comment first part (uncommented paragraph)...
                    
                    (setq enx (if (assoc 1 enx) (subst (assoc 1 fieldx) (assoc 1 enx) enx) (append enx (list (assoc 1 fieldx)))))
                    (setq enx (vl-remove-if '(lambda ( x ) (eq (cdr x) (cadr maintxtparentchild))) enx))
                    (entupd (cdr (assoc -1 enx)))

                    ;;; (setq txt (entmakex (append (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")) (list (assoc 1 fieldx)) (vl-remove-if '(lambda ( x ) (vl-position (car x) '(0 1 5 100 330))) enx))))
                    ;;; (entdel (cdr (assoc -1 enx)))
                  )
                )
              )
            )
          )
        )
        (progn
          (prompt "\nNothing selected...")
          (if (= 4 (LM:popup "REPLACE FIELDS VALUES WITH TEXTUAL VALUES" "Choose option : " 53))
            (c:replacefields2textsvalues)
          )
        )
      )
    )
    (prompt "\nNo visible objects detected in DWG... Draw or append some objects and restart routine next time...")
  )
  (princ)
)

 

HTH.

Regards, M.R.

Edited by marko_ribar
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

I've fixed my attempt in a manner that it's debugged... So routine works as should, but then again - result is somewhat unexpected... So, continue to work on it... I hope it helps at least in some point... When you get it working, please inform us so that someone can find it useful in future...

  

(defun c:replacefields2textsvalues ( / _getnestedfields _getmaintxtparentchild LM:popup ss i e fields l fieldx maintxtparentchild maintxtparent enx ent k )

  (vl-load-com) ;;; load AciveX extensions (VLA functions) ;;; you can remove this line - it's only needed for LM:popup (sub function)...

  (defun _getnestedfields ( e / mainfoo enx historylist r )

    (defun mainfoo ( enxxl / foo )

      (defun foo ( enx / enxx enxxl )
        (if (not (vl-position (cdr (assoc -1 enx)) historylist))
          (progn
            (setq historylist (cons (cdr (assoc -1 enx)) historylist))
            (if (vl-some '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx)
              (setq enxx (entget (cdr (assoc (vl-some '(lambda ( x ) (if (and (= (type (cdr x)) 'ename) (/= (car x) 330)) (car x))) enx) enx)) '("*")))
              (setq enxx nil)
            )
            (cond
              ( (equal (assoc 0 enx) (cons 0 "FIELD"))
                (setq r (cons enx r))
                (if enxx
                  (setq enxxl (mapcar '(lambda ( x ) (entget (cdr x) '("*"))) (vl-remove-if-not '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx)))
                )
              )
              ( enxx
                (setq enxxl (mapcar '(lambda ( x ) (entget (cdr x) '("*"))) (vl-remove-if-not '(lambda ( x ) (and (= (type (cdr x)) 'ename) (/= (car x) 330))) enx)))
              )
            )
          )
        )
        enxxl
      )

      (if enxxl
        (mainfoo (apply 'append (mapcar '(lambda ( x ) (foo x)) enxxl)))
      )
    )

    (setq enx (entget e '("*")))
    (mainfoo (list enx))
    (if r
      (mapcar '(lambda ( x ) (cdr (assoc -1 x))) r)
    )
  )

  (defun _getmaintxtparentchild ( fieldx / enx enxx )
    (setq enx fieldx)
    (while (not (wcmatch (cdr (assoc 0 (entget (cdr (assoc 330 enx)) '("*")))) "*ATT*,*TEXT"))
      (setq enx (entget (cdr (assoc 330 enx)) '("*")))
    )
    (setq enxx (cdr (assoc 330 enx)))
    (if enxx
      (list enxx (cdr (assoc -1 enx)))
    )
  )

  ;; Popup  -  Lee Mac
  ;; A wrapper for the WSH popup method to display a message box prompting the user.
  ;; ttl - [str] Text to be displayed in the pop-up title bar
  ;; msg - [str] Text content of the message box
  ;; bit - [int] Bit-coded integer indicating icon & button appearance
  ;; Returns: [int] Integer indicating the button pressed to exit

  (defun LM:popup ( ttl msg bit / wsh rtn )
    (if (setq wsh (vlax-create-object "wscript.shell"))
      (progn
        (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit)))
        (vlax-release-object wsh)
        (if (not (vl-catch-all-error-p rtn)) rtn)
      )
    )
  )

  (if (ssget "_A" (list '(0 . "~VIEWPORT") '(60 . 0) (cons 410 (if (= (getvar 'cvport) 1) (getvar 'ctab) "Model"))))
    (progn
      (prompt "\nSelect objects on unlocked layer(s) - preferable is that you type here \"ALL\" in order to make operation working on all visible entities of current/active space/layout...")
      (if (setq ss (ssget "_:L"))
        (progn
          (repeat (setq i (sslength ss))
            (setq e (ssname ss (setq i (1- i))))
            (if (= (cdr (assoc 0 (entget e '("*")))) "FIELD")
              (setq fields (cons e fields))
              (if (setq l (_getnestedfields e))
                (setq fields (append fields l))
              )
            )
          )
          (setq k 0)
          ;;; (princ fields) ;;; if you want to see if something was collected - (0 . "FIELD") enitites...
          (foreach field fields
            (setq fieldx (entget field '("*")))
            (setq maintxtparentchild (_getmaintxtparentchild fieldx))
            (if (setq maintxtparent (car maintxtparentchild))
              (progn
                (setq enx (entget maintxtparent '("*")))
                ;;; first processing operation ;;;
                (setq enx (if (assoc 1 enx) (subst (assoc 1 fieldx) (assoc 1 enx) enx) (append enx (list (assoc 1 fieldx)))))
                (setq enx (vl-remove-if '(lambda ( x ) (eq (cdr x) (cadr maintxtparentchild))) enx))
                (entupd (cdr (assoc -1 enx)))
                ;;; second processing operation ;;;
                (if (not (equal enx (entget (cdr (assoc -1 enx)) '("*")))) ;;; change didn't happen, so proceed to next procedure... ;;;
                  (progn
                    (entmake (append (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")) (list (assoc 1 fieldx)) (vl-remove-if '(lambda ( x ) (vl-position (car x) '(0 1 5 100 330))) enx)))
                    (entdel (setq ent (cdr (assoc -1 enx))))
                    (if (vlax-erased-p ent)
                      (setq k (1+ k))
                    )
                  )
                  (setq k (1+ k))
                )
              )
            )
          )
          (prompt (strcat "\Processed total : " (itoa k) " FIELD entities (nested or not)..."))
        )
        (progn
          (prompt "\nNothing selected...")
          (if (= 4 (LM:popup "REPLACE FIELDS VALUES WITH TEXTUAL VALUES" "Choose option : " 53))
            (c:replacefields2textsvalues)
          )
        )
      )
    )
    (prompt "\nNo visible objects detected in DWG... Draw or append some objects and restart routine next time...")
  )
  (princ)
)

 

Edited by marko_ribar
  • Like 1
BIGAL Grand Master

BIGAL

Posted
Posted

Just tested used 

  

(setq obj (vlax-ename->vla-object (car  (nentsel "Pick obj")))) ; pick attribute
(setq str (vla-get-textstring obj))
"\\W0.7000;=262,00"
; strip the mtext coding say Lee-mac striptmtext
str = "262,00"
(vla-put-textstring str)

Bit busy at moment. Will try to find time.

VAC Contributor

VAC

Posted
  • Author
Posted (edited)

Hi,

I found this lisp. It works, but not on Tables and Mtexts with fields. Any solution?

https://forums.augi.com/showthread.php?72534-Convert-Field-to-Text-within-Block-Globally

  

(vl-load-com)
(defun c:FLD2TXT (/ ss n bn an ad s)
  (prompt
    "Select the objects you wish to remove the field links from: "
  ) ;_ end of prompt
  (setq ss (ssget '((0 . "INSERT,MTEXT,DIMENSION,TEXT,MULTILEADER")))) ;Get selection set from sample2.dwguser
  (setq n 0) ;Initialize counter
  ;; Step through selection set one entity at a time
  (while (< n (sslength ss))
    (setq bn (ssname ss n)) ;Get the nth entity in the selection set
    (setq ad (entget bn)) ;Get the entity's data
    (cond
      ((= "INSERT" (cdr (assoc 0 ad))) ;Check if block
       (setq an (entnext bn)) ;Get the next enity after bn
       ;; Step through each next entity until it is not an attribute
       (while (and an ;Check if entity is found
                   (setq ad (entget an)) ;Get data
                   (= "ATTRIB" (cdr (assoc 0 ad))) ;Check if attribute
              ) ;_ end of and
         (setq s (cdr (assoc 1 ad))) ;Get text value
         (entmod (list (assoc -1 ad) (cons 1 ""))) ;Modify the entity
         (entmod (list (assoc -1 ad) (cons 1 s))) ;Modify the entity
         (entupd an) ;Update screen to show change
         (setq an (entnext an)) ;Get next entity
       ) ;_ end of while
      )
      ((= "MULTILEADER" (cdr (assoc 0 ad))) ;Check if block
       (setq ad (vlax-ename->vla-object bn)
             s (vla-get-TextString ad)
             )
       (vla-put-TextString ad "")
       (vla-put-TextString ad s)
      )
      ;; Anything else
      (t
       (setq s (cdr (assoc 1 ad))) ;Get text value
       (entmod (list (assoc -1 ad) (cons 1 ""))) ;Modify the entity
       (entmod (list (assoc -1 ad) (cons 1 s))) ;Modify the entity
       (entupd an) ;Update screen to show change
      )
    )
    (setq n (1+ n)) ;Increment counter
  ) ;_ end of while
  (setq ss nil) ;Clear selection set
  (gc) ;Clear unused memory
  (princ)
) ;_ end of defun

 

sample2.dwg

Edited by VAC

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.

×
 Share
Go to topic listing
×
×
  • Create New...