Topic: xref attribute work around

[Lee Mac]

the text is not nested it is live in the file

Sorry, I thought the text was part of the XRef...

So you just want the user to select some text, and add this text to the Layout name? or am I still misunderstanding?

[jbuzbee]

Found it.  Told you it was easy.

Code: [Select]

(defun kb:swapblock  (ent newBlockName / new_blk)
  (setq new_blk (subst (cons 2 newBlockName) (assoc 2 ent) ent))
  (entmod new_blk)
  (princ "\nBlock swapped!"))
So you xref and insert the same file.  Rename the xref first, then insert, then use the code above to swap the block for the xref.  AutoCAD will now think the block is an xref so you have to call the attedit command to edit the attributes (double-clicking brings up the reference editor).

Then erase the original xref and move the block / xref hybrid into it's place.  When the xref is reloaded the attributes remain in tact.

Just tested on AutoCAD 2009.  I used to have a real slick routine that did all of the above automatically, but can't find it.

jb

[cadman6735]

lee

you hit the nail but...

It is not as simple (for me) as just taking the text string and adding it to the layout tab.  I could do that, yeah me.

I want the file to remember the name and check the name each time I plot or when the text is edited, does not matter as long as the tab updates when the name and number has changed.

Which if I could figure out how to select a text object via vlisp (which I am find very difficult at the momment) I would use (vlax-data) or if USERS1 would hold its value I would go this route.

[cadman6735]

buzz

I am sorry man, I am an idiot, I am having a hard time understanding how it works...  I am not too experianced with arguments and after running the app. I get "too few arguments"...

I hate the fact that I am the one that has to be lead by the nose to understand.

1.  I xrefed in the border
2.  I renamed the xref
3.  Then I inserted the re-named xref via bind-insert?
4.  Then I xrefed another border in so I can run your code on the block in step 3 with the xref I just xrefed in
5.  Then ran your code

(kb:swapblock)
*Cancel*
too few arguments

[cadman6735]

It took me all day to figure out the visual lisp version of my other code posted...  And it still doesn't work...   :realmad:


I have no clue what I am missing.  How can I store an object handle so I can call it after the acad has closed and reopend?

  (defun c:get ( / entHandle)

  (vl-load-com)

  (setq
    acadObject         (vlax-get-acad-object)
    acadActiveDocument      (vla-get-ActiveDocument acadObject)
    acadUtility         (vla-get-Utility acadActiveDocument)
   
  )

    (vla-getentity acadUtility 'obj 'ip "\nPlease Select Sheet Name")

    (setq entHandle (vla-get-handle obj))

    (vlax-ldata-put obj "Handle" entHandle)

    (princ)
)

;----------------------------------------------------------------------------------------------------------------

  (defun c:put ( / )

  (vl-load-com)

  (print (vlax-ldata-get obj "Handle"))

  (princ)
)

[Lee Mac]

Why are you attempting to store an object's handle in the LData of that same object? The object handle is unchanged between drawing sessions.

[cadman6735]

I don't know.

I just want to have a variable store the handle so I can access the object for future use once the program as been saved and closed and reopened.

I have tried USERS1

I have tried my first version of the code using ldata

I have tried my second version of the code using ldata

I am now trying xdata, going thru a tutorial by AfraLisp.

I want to use USERS1 seems the most simple but it does not hold the value and I don't know why.

[cadman6735]

now you say

same object

xdata is not the way to go either, it is also sToring it in the same object, which does not help me unless I can access it via the handle.

I'm going to find something to break  :pissed:  and start again tomorrow.

stupid lisp...  just kidding

but I want to "AAAHAHHAAA"

[Lee Mac]

I thought this would be a good exercise in using reactors (I don't write too many reactor based programs - they are volatile...).

The following code uses an ObjectReactor monitoring a user-selected Text Object.

Start the program with 'SyncText', and select a text object (in Paperspace) to be synced with the Layout in which it resides. After selection, xData will be added to the text object so that the transcient reactors may be rebuilt when the drawing is next opened.

Notice that when the text is edited, the Layout name is automatically updated.

Save/Close the drawing.

When you next open the drawing, load my program to rebuild the reactors and the text and layout will once again be synced.

Type 'UnSyncText' to remove the link.

Code: [Select]

(defun c:SyncText ( / *error* ss object objreactor comreactor ) 
  ;; Example © Lee Mac 2011
 
  (defun *error* ( msg )
    (setvar 'NOMUTT 0)
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ)
  )
 
  (if (= 1 (getvar 'CVPORT))
    (progn
      (setvar 'NOMUTT 1)
      (princ "\nSelect Text to Sync with Layout: ")
      (setq ss (ssget "_+.:S:E" (list (cons 0 "TEXT") (cons 410 (getvar 'CTAB)))))
      (setvar 'NOMUTT 0)
     
      (if ss
        (progn
          (SyncText:Remove (getvar 'CTAB))
          (setq object (vlax-ename->vla-object (ssname ss 0)))
         
          (if (not (tblsearch "APPID" "LMAC-SyncText"))
            (regapp "LMAC-SyncText")
          )
          (entmod
            (list (cons -1 (ssname ss 0))
              (list -3
                (list "LMAC-SyncText"
                 '(1002 . "{") (cons 1000 (getvar 'CTAB)) '(1002 . "}")
                )
              )
            )
          )
          (if (setq objreactor (car (SyncText:GetReactors "LayoutSyncReactor" '(:vlr-object-reactor))))
            (progn
              (if (not (vlr-added-p objreactor))
                (vlr-add objreactor)
              )
              (vlr-owner-add objreactor object)
            )
            (vlr-object-reactor (list object) "LayoutSyncReactor"
              (list
                (cons :vlr-modified 'SyncText:Modified)
                (cons :vlr-erased   'SyncText:Erased)
              )
            )
          )
          (if (setq comreactor (car (SyncText:GetReactors "LayoutSyncReactor" '(:vlr-command-reactor))))
            (if (not (vlr-added-p comreactor))
              (vlr-add comreactor)
            )
            (vlr-command-reactor "LayoutSyncReactor"
              (list
                (cons :vlr-commandwillstart 'SyncText:Command)
              )
            )
          )
          (SyncText:Modified object reactor params)
          (princ "\n--> Text Synced with Layout.")
        )
      )
    )
    (princ "\n--> Command Only Available in Paperspace.")
  )
  (princ)
)

(defun SyncText:Remove ( layout / reactors objreactor )
  (mapcar 'vlr-remove
    (setq reactors
      (append
        (SyncText:GetReactors "LayoutSyncReactor" '(:vlr-object-reactor))
        (SyncText:GetReactors "LayoutSyncReactor" '(:vlr-command-reactor))
      )
    )
  )
  (
    (lambda ( / ss i )
      (if (setq ss (ssget "_X" (list '(0 . "TEXT") '(-3 ("LMAC-SyncText")) (cons 410 layout))))
        (repeat (setq i (sslength ss))
          (entmod
            (list (cons -1 (ssname ss (setq i (1- i))))
             '(-3 ("LMAC-SyncText"))
            )
          )
          (vlr-owner-remove (car reactors) (vlax-ename->vla-object (ssname ss i)))
        )
      )
    )
  )
  (and reactors (or (null (vlr-owners (car reactors))) (mapcar 'vlr-add reactors)))
  (princ)
)

(defun c:UnSyncText nil
  (SyncText:Remove "*")
  (princ)
)

(defun SyncText:Modified ( object reactor params )
  (or *acdoc*
    (setq *acdoc*
      (vla-get-ActiveDocument (vlax-get-acad-object))
    )
  )
  (if
    (not
      (or *UndoCalled*
        (vlax-erased-p object)
      )
    )
    (vl-catch-all-apply 'vla-put-name
      (list
        (vla-get-layout
          (vla-objectidtoobject *acdoc* (vla-get-ownerid object))
        )
        (vla-get-TextString object)
      )
    )
  )
  (princ)
)

(defun SyncText:Erased ( object reactor params )
  (vlr-remove reactor)
  (princ)
)

(defun SyncText:Command ( reactor params )
  (setq *UndoCalled* (wcmatch (strcase (car params)) "*U*"))
  (princ)
)

(defun SyncText:GetReactors ( data types )
  (vl-remove-if-not
    (function
      (lambda ( reactor )
        (eq data (vlr-data reactor))
      )
    )
    (apply 'append
      (mapcar 'cdr (apply 'vlr-reactors types))
    )
  )
)

(vl-load-com)

(
  (lambda ( / ss )
    (if
      (and
        (not
          (vl-some
            (function
              (lambda ( reactor )
                (eq "LayoutSyncReactor" (vlr-data reactor))
              )
            )
            (apply 'append
              (mapcar 'cdr
                (vlr-reactors :vlr-object-reactor :vlr-command-reactor)
              )
            )
          )
        )
        (setq ss (ssget "_X" '((0 . "TEXT") (-3 ("LMAC-SyncText")))))
      )
      (progn
        (vlr-object-reactor
          (
            (lambda ( / l i )
              (repeat (setq i (sslength ss))
                (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
              )
            )
          )
          "LayoutSyncReactor"
          (list
            (cons :vlr-modified 'SyncText:Modified)
            (cons :vlr-erased   'SyncText:Erased)
          )
        )
        (vlr-command-reactor "LayoutSyncReactor"
          (list
            (cons :vlr-commandwillstart 'SyncText:Command)
          )
        )
      )
    )
  )
)

(princ)
Currently only for one text object Updated for multiple Layouts, but a lot of coding for little gain IMO though.

Lee

[cadman6735]

Lee
I am humbled by you.  I didn't want or ask you to write this code for me but now that you have I can't thank you enough.  I can see (by your code) the task that I am trying to undertake is way over my skill set.  I can only assume that you program for a living and with a tool like this, this is something you need to be paid for.  I am not sure what a fare price would be and I honestly can not afford to pay you for it but if we can work something out, I will happly reimburse your time.

This tool will save us a ton of time in down production when trying to get jobs out the door.  Our Print shop spend hours renaming PDF's when they could and should be doing more proactive tasks.  You think this is little gain, I disagree.

  -  If I can ask you for one more favor (you have already done way too much for me), to make this work with MText, so we can have multiple lines in our sheet title, a title very rarly is one line.

I hesitate to ask, but we can not use this tool unless it is Mtext.  If you don't want to or don't have the time to mess with it, I understand and will take what is given to me and just say THANK YOU.  The ease that you write this stuff  is what I strive for.  I am humbled.

[Lee Mac]

I am humbled by you.  I didn't want or ask you to write this code for me but now that you have I can't thank you enough.  I can see (by your code) the task that I am trying to undertake is way over my skill set.  I can only assume that you program for a living and with a tool like this, this is something you need to be paid for.  I am not sure what a fare price would be and I honestly can not afford to pay you for it but if we can work something out, I will happly reimburse your time.

Many thanks for your kind words CADman - I appreciate it. Of course, I didn't write the code expecting reimbursement - initially, this was a good exercise for me in programming using reactors (I don't write too many reactor based programs), and I would furthermore state that the current code is by no means 'bulletproof' (I find it very difficult to make a program completely robust when invoking reactors since one must account for all possible scenarios [e.g. note the extra command reactor required to prevent a crash when Undo is called] - but perhaps this a lack of knowledge in this area on my part). That said, of course, if you do feel compelled to make a donation to either theSwamp or my site, both will be welcomed.

This tool will save us a ton of time in down production when trying to get jobs out the door.  Our Print shop spend hours renaming PDF's when they could and should be doing more proactive tasks.  You think this is little gain, I disagree.

I'm glad that it can save you time in your work - my earlier comment regarding the 'little gain' was more remarking upon how much code was required to merely link a text object to the Layout Name - if only Fields were permitted in Layout Names, this would be a walk in the park.

If I can ask you for one more favor (you have already done way too much for me), to make this work with MText, so we can have multiple lines in our sheet title, a title very rarly is one line.

The program could indeed be modified to accept MText, however I foresee problems where MText formatting is concerned (it could be removed of course), and also in that Layout Names may only consist of a single line with a limited number of characters (254?)

I hesitate to ask, but we can not use this tool unless it is Mtext.  If you don't want to or don't have the time to mess with it, I understand and will take what is given to me and just say THANK YOU.  The ease that you write this stuff  is what I strive for.  I am humbled.

To be honest, its mostly practice - many times I study the code others have posted and try to take ideas further, or code something in a different way.

Happy I could help,

Lee

[cadman6735]

That said, of course, if you do feel compelled to make a donation to either theSwamp or my site, both will be welcomed.

Indeed, I will make a donation to both, your site and the swamp.  When I can afford to do so, the economy here in the states has me stagnent in sallery and only a single income family.  I wish I could donate today.  This kind gesture of yours will not be fogotten.

To be honest, its mostly practice - many times I study the code others have posted and try to take ideas further, or code something in a different way.

Then I am on the right path, I do nothing other than read and study forums and old posts and code, I am determined to learn.  Though I do find it frustraiting and overwhelming.

Life is good and people like you make it better.
Have great weekend.

[Lee Mac]

Life is good and people like you make it better.
Have great weekend.

That's very kind of you CADMan, have a great weekend too 

[Lee Mac]

This should hopefully work with MText:

Code: [Select]

(defun c:SyncText ( / *error* ss object ) 
  ;; Example © Lee Mac 2011
 
  (defun *error* ( msg )
    (setvar 'NOMUTT 0)
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ)
  )
 
  (if (= 1 (getvar 'CVPORT))
    (progn
      (setvar 'NOMUTT 1)
      (princ "\nSelect Text to Sync with Layout: ")
      (setq ss (ssget "_+.:S:E" (list (cons 0 "TEXT,MTEXT") (cons 410 (getvar 'CTAB)))))
      (setvar 'NOMUTT 0)
     
      (if ss
        (progn
          (SyncText:Remove (getvar 'CTAB))
          (setq object (vlax-ename->vla-object (ssname ss 0)))
         
          (if (not (tblsearch "APPID" "LMAC-SyncText")) (regapp "LMAC-SyncText"))
          (entmod
            (append (entget (ssname ss 0))
              (list
                (list -3
                  (list "LMAC-SyncText"
                   '(1002 . "{") (cons 1000 (getvar 'CTAB)) '(1002 . "}")
                  )
                )
              )
            )
          )
          (if SyncText:ObjectReactor
            (progn
              (if (not (vlr-added-p SyncText:ObjectReactor)) (vlr-add SyncText:ObjectReactor))
              (vlr-owner-add SyncText:ObjectReactor object)
            )
            (setq SyncText:ObjectReactor
              (vlr-object-reactor (list object) "SyncTextObjectReactor"
                (list
                  (cons :vlr-modified 'SyncText:Modified)
                )
              )
            )
          )
          (if SyncText:CommandReactor
            (if (not (vlr-added-p SyncText:CommandReactor)) (vlr-add SyncText:CommandReactor))
            (setq SyncText:CommandReactor
              (vlr-command-reactor "SyncTextCommandReactor"
                (list
                  (cons :vlr-commandwillstart 'SyncText:Command)
                )
              )
            )
          )
          (SyncText:Modified object nil nil)
          (princ "\n--> Text Synced with Layout.")
        )
      )
    )
    (princ "\n--> Command Only Available in Paperspace.")
  )
  (princ)
)

(defun SyncText:Remove ( layout )
  (if
    (and SyncText:ObjectReactor SyncText:CommandReactor
      (mapcar 'vlr-remove (list SyncText:ObjectReactor SyncText:CommandReactor))
    )
    (
      (lambda ( / ss i )
        (if (setq ss (ssget "_X" (list '(0 . "TEXT,MTEXT") '(-3 ("LMAC-SyncText")) (cons 410 layout))))
          (repeat (setq i (sslength ss))
            (entmod
              (list (cons -1 (ssname ss (setq i (1- i)))) '(-3 ("LMAC-SyncText")))
            )
            (vlr-owner-remove SyncText:ObjectReactor (vlax-ename->vla-object (ssname ss i)))
          )
        )
        (if (vlr-owners SyncText:ObjectReactor)
          (mapcar 'vlr-add (list SyncText:ObjectReactor SyncText:CommandReactor))
        )
      )
    )
  ) 
  (princ)
)

(defun c:UnSyncText nil
  (SyncText:Remove "*")
  (princ)
)

(defun SyncText:Modified ( object reactor params / dstring mstring )
  (or *acdoc*
    (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (if (and SyncText:RegExp (not *UndoCalled*))
    (if (vlax-erased-p object)
      (progn
        (vlr-owner-remove SyncText:ObjectReactor object)
        (if (null (vlr-owners SyncText:ObjectReactor))
          (mapcar 'vlr-remove (list SyncText:ObjectReactor SyncText:CommandReactor))
        )
      )
      (if
        (vl-catch-all-error-p
          (setq err
            (vl-catch-all-apply 'vla-put-name
              (list
                (vla-get-layout
                  (vla-objectidtoobject *acdoc* (vla-get-ownerid object))
                )
                (progn
                  (LM:GetTrueContent SyncText:RegExp (vlax-vla-object->ename object) 'dstring 'mstring)
                  dstring
                )
              )
            )
          )
        )
        (princ (strcat "\n--> Error: " (vl-catch-all-error-message err)))
      )
    )
  )
  (princ)
)

(defun SyncText:Command ( reactor params )
  (setq *UndoCalled* (wcmatch (strcase (car params)) "*U*"))
  (princ)
)

(vl-load-com)

(
  (lambda ( / ss )
    (if
      (and
        (not (and SyncText:ObjectReactor SyncText:CommandReactor))
        (setq ss (ssget "_X" '((0 . "TEXT") (-3 ("LMAC-SyncText")))))
      )
      (progn
        (if (not SyncText:ObjectReactor)
          (setq SyncText:ObjectReactor
            (vlr-object-reactor
              (
                (lambda ( / l i )
                  (repeat (setq i (sslength ss))
                    (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
                  )
                )
              )
              "SyncTextObjectReactor" (list (cons :vlr-modified 'SyncText:Modified))
            )
          )
        )
        (if (not SyncText:CommandReactor)
          (setq SyncText:CommandReactor
            (vlr-command-reactor "SyncTextCommandReactor"
              (list
                (cons :vlr-commandwillstart 'SyncText:Command)
              )
            )
          )
        )
      )
    )
    (if (not SyncText:RegExp)
      (setq SyncText:RegExp (vlax-create-object "VBScript.RegExp"))
    )
    (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
)


;;------------------=={ Get True Content }==------------------;;
;;                                                            ;;
;;  Returns the unformatted string associated with the        ;;
;;  supplied entity, in formats compatible with Text & MText  ;;
;;  objects.                                                  ;;
;;                                                            ;;
;;  The arguments *dtextstring & *mtextstring should be       ;;
;;  supplied with quoted symbols (other than those symbols    ;;
;;  used by the arguments themselves). The unformatted        ;;
;;  strings suitable for Text & MText objects will henceforth ;;
;;  be bound to the supplied symbol arguments respectively.   ;;
;;                                                            ;;
;;  Note that it is the caller's responsibility to create and ;;
;;  release the RegularExpressions (RegExp) object. This      ;;
;;  object may be created using the                           ;;
;;  Programmatic Identifier: "VBScript.RegExp".               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  RegExp       - RegularExpressions (RegExp) Object         ;;
;;  entity       - Ename whose text content is to be returned ;;
;;  *dtextstring - (output) Unformatted string compatible     ;;
;;                 with Text entities                         ;;
;;  *mtextstring - (output) Unformatted string compatible     ;;
;;                 with MText entities                        ;;
;;------------------------------------------------------------;;
;;  Returns:    This function always returns nil              ;;
;;------------------------------------------------------------;;

(defun LM:GetTrueContent ( RegExp entity *dtextstring *mtextstring / _Replace _AllowsFormatting _GetTextString )

  (defun _Replace ( new old string )
    (vlax-put-property RegExp 'pattern old) (vlax-invoke RegExp 'replace string new)
  )

  (defun _AllowsFormatting ( entity / object )   
    (or (wcmatch (cdr (assoc 0 (entget entity))) "MTEXT,MULTILEADER")     
      (and
        (eq "ATTRIB" (cdr (assoc 0 (entget entity))))
        (vlax-property-available-p (setq object (vlax-ename->vla-object entity)) 'MTextAttribute)
        (eq :vlax-true (vla-get-MTextAttribute object))
      )
    )
  )

  (defun _GetTextString ( entity )
    (
      (lambda ( entity / _type elist )
        (cond
          ( (wcmatch (setq _type (cdr (assoc 0 (setq elist (entget entity))))) "TEXT,*DIMENSION")
           
            (cdr (assoc 1 (reverse elist)))
          )
          ( (eq "MULTILEADER" _type)

            (cdr (assoc 304 elist))
          )
          ( (wcmatch _type "ATTRIB,MTEXT")

            (
              (lambda ( string )
                (mapcar
                  (function
                    (lambda ( pair )
                      (if (member (car pair) '(1 3))
                        (setq string (strcat string (cdr pair)))
                      )
                    )
                  )
                  elist
                )
                string
              )
              ""
            )
          )
        )
      )
      (if (eq 'VLA-OBJECT (type entity))
        (vlax-vla-object->ename entity)
        entity
      )
    )
  )

  (
    (lambda ( string )
      (if string
        (progn
          (mapcar
            (function
              (lambda ( x ) (vlax-put-property RegExp (car x) (cdr x)))
            )
            (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue))
          )
          (if (_AllowsFormatting entity)
            (mapcar
              (function
                (lambda ( x ) (setq string (_Replace (car x) (cdr x) string)))
              )
             '(
                ("Ð"       . "\\\\\\\\")
                (" "       . "\\\\P|\\n|\\t")
                ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                ("$1"      . "[\\\\]({)|{")
              )
            )
            (setq string (_Replace "" "%%[OoUu]" (_Replace "Ð" "\\\\" string)))
          )
          (set *mtextstring (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" string)))
          (set *dtextstring (_Replace "\\"   "Ð" string))
        )
      )
    )
    (_GetTextString entity)
  )
  nil
)

(princ)
It uses my GetTrueContent sub from here to remove any formatting codes present in the MText string.

I have also changed my method of manipulating the reactor objects to use global variables as this results in slightly less code. 

[cadman6735]

All I can say is thank you.

Thank you.