Copy or Swap Text

[Lee Mac]

Lee, attached you will find a drawing in which it errors out on. Thank you so much for your help on this!

 

Many thanks for providing the sample drawing broncos15, and for your time spent testing the program - please try the updated version here (V1.6).

[Happy Hobbit]

Kinda soothing to know even the great Lee Mac has to change his code a few days after writing it !

 

I often have to do this, beginning to wonder if a lisp is ever 'finished' or forever a WIP

[Lee Mac]

Kinda soothing to know even the great Lee Mac has to change his code a few days after writing it !

 

I often have to do this, beginning to wonder if a lisp is ever 'finished' or forever a WIP

 

Indeed, for programs such as this which operate on such a wide range of objects including nested objects, it can be difficult to account for every possible eventuality and allow for every possible object configuration. For example, the particular bug which broncos15 detected was the result of the program accessing the DIMASSOC entity for an associative dimension as opposed to the parent entity (both use the 330 DXF group) when testing the name of the block container for the object.

 

I do not doubt that one may find faults with many of my programs, and moreover I openly welcome others to find such faults & critique the code, as this form of feedback loop will result in an improved program and one can also build on the knowledge gained in the debugging exercise and apply such knowledge to future programs.

[broncos15]

Lee, thank you so much for looking into it, and the correction. I have tested the ctx and stx programs for a day on many of my drawings, and I haven't gotten anything to error unexpectantly. Thanks again for posting the program, your codes and what I have learned from them, have been invaluable.

[zaphod]

Lee Mac,

your code is inspiring, is there a way to make it work in paper space, with the text in model space?

also could there be and atx (add to end of text) function?

either way it is still a nice piece of code as is.

[yathishkumar]

Error: Automation Error. Key not found

 

i have created new multi leader attribute block it's working fine. once i modified the same block in block editor then saved to drawing it showing error.

[Lee Mac]

Lee, thank you so much for looking into it, and the correction. I have tested the ctx and stx programs for a day on many of my drawings, and I haven't gotten anything to error unexpectantly. Thanks again for posting the program, your codes and what I have learned from them, have been invaluable.

 

Excellent to hear broncos15 - thank you once again for your time testing the program, I'm pleased to hear that the program is running smoothly for you.

 

is there a way to make it work in paper space, with the text in model space?

 

This is theoretically possible, but would involve rewriting the entire object selection function to use a grread imitation of the entsel/nentsel/nentselp functions, as these functions will simply return nil when attempting to select an object through an inactive viewport. As such, I'm not so sure that the ends justify the means for this suggestion, but thank you anyway.

 

also could there be and atx (add to end of text) function?

 

Thank you for the suggestion - an 'append text' option could indeed prove quite useful for some situations, I'll see what I can do.

 

either way it is still a nice piece of code as is.

 

Thank you!

 

Error: Automation Error. Key not found

 

i have created new multi leader attribute block it's working fine. once i modified the same block in block editor then saved to drawing it showing error.

 

Thank you for the report - I'll look into it!

[bababarghi]

Lee, is there any command line version of your CTB/STB?

[Lee Mac]

Lee, is there any command line version of your CTB/STB?

 

I'm not sure what you mean - the current code for my Copy/Swap Text program does not display a GUI...

[bababarghi]

I'm not sure what you mean - the current code for my Copy/Swap Text program does not display a GUI...

 

I was thinking if there is a way to utilise your lisp in a script i.e. pre-defining source and destination in the call rather than giving user the option to select after call.

[zaphod]

I noticed a bug with this code the other day trying to use it on dimensions with text, instead of the value it just gives you the , but I still love this code.

[Lee Mac]

I noticed a bug with this code the other day trying to use it on dimensions with text, instead of the value it just gives you the , but I still love this code.

 

When selecting a Dimension as the source object, the program will use the text override if present, otherwise the dimension value if the text override is blank.

 

I'm glad you find the program useful!

[snebel]

Just want to say your programs are absolutely fantastic Lee.

I had a quick query about combining this lisp and text calculator. Where you would use text calculator but then be able to place the value into the destination text.

Just wondering if this is possible.

[Lee Mac]

Just want to say your programs are absolutely fantastic Lee.

I had a quick query about combining this lisp and text calculator. Where you would use text calculator but then be able to place the value into the destination text.

Just wondering if this is possible.

 

Thank you for your positive feedback -

You might find my new Field Arithmetic program useful in this regard.

[RubberDinero]

I love this lisp, have used it on a daily for years now.  Today I had to use it on a block that consists of 5 columns of attributes and 20 rows. The visibility is controlled by a linear stretch parameter where you only see the amounts of rows you want to see. 

 

The attribute are named as followed and sequentially increased suffix. 

OPERATING1 INST_REM1 EQUIP1 SERIAL1 ADDRESS1

OPERATING2...

 

I needed to remove 1 row somewhere in the middle, so i had to run the STX 50+ times to keep shifting the values upwards, luckily it was only 7 rows and I could hit the spacebar to restart the STX command, still faster than typing it. is there a way to may STX an array of selected values?

 

Or this task specific, is there a way to create a lisp that if I click on OPERATING13 it will automatically retrieve the values for INST_REM13, EQUIP13, etc and then I could click on OPERATING9 and swap the pertaining rows?

 

Any feedback is appreciated.

 

Thanks,

[aksha]

On 6/24/2017 at 2:43 PM, Lee Mac said:

 

Thank you for your positive feedback -

You might find my new Field Arithmetic program useful in this regard.

Lee,

I have used many of your routines and I too find them very detailed and useful. They are great source of information for someone trying to learn LISP.
I am using AutoCAD LT 2024 And CopySwapTextV1-8.lsp (and V1.6) fails on load with following message. Any pointers?
argument is not a vl-catch-all-apply error: nil

[Lee Mac]

1 hour ago, aksha said:

Lee,

I have used many of your routines and I too find them very detailed and useful. They are great source of information for someone trying to learn LISP.
I am using AutoCAD LT 2024 And CopySwapTextV1-8.lsp (and V1.6) fails on load with following message. Any pointers?
argument is not a vl-catch-all-apply error: nil

 

Since LT does not support interfacing with objects outside of the AutoCAD Object Model, this program (and several others) is unfortunately not compatible on that platform.

 

Admittedly, I need to update the program to handle the error more gracefully.

[aksha]

1 hour ago, Lee Mac said:

 

Since LT does not support interfacing with objects outside of the AutoCAD Object Model, this program (and several others) is unfortunately not compatible on that platform.

 

Admittedly, I need to update the program to handle the error more gracefully.

Thank you for a prompt reply!

[Steven P]

Not sure if this is any good.

 

A while ago I thought "That Lee Mac CTX code, I can do that..." just coding not as well as it turns out. I think there are a couple of lines in here that I am not sure if LT will handle - a VLAX- to update the new text string is the main one.

 

(a part of a longer file of text LISPs so while some of this can be done more succinctly, other stuff might be using some of this too.. but also means I might have missed copying something in here) 

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;ent get or nentget a single entity
;;note entget for example in dimensions, nentget for the rest
;;aprompt: What do you want to ask, Enttype entity type filter, wildard * allowed
;;for example (setq Enttype "TEXT,MTEXT,ATTRIB") ; list of entity to select, except dimensions?
(defun getent ( aprompt Enttype / endloop enta entb pt result LP)
  (defun LM:rand ( / a c m )
    (setq m   4294967296.0
          a   1664525.0
          c   1013904223.0
          $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
    )
    (/ $xn m)
  )

  (setvar "errno" 0)
  (setq endloop "No")
  (while (and (= endloop "No")(/= 52 (getvar "errno")) )
    (setq LP (getvar "lastpoint"))
    (setq result (nentselp aprompt))

    (cond
      ((= 'list (type result)) ;;do stuff with ENT
        (if (not (wcmatch (cdr (assoc 0 (entget (car result)))) Enttype) )
          (progn
            (princ (strcat "\nThats not " Enttype "...\n"))
          ) ; end progn
          (progn
            (setq LMRad (LM:rand)) ; random message
            (cond
              ((< LMRad 0.6)(princ "I thank you, that is selected OK. ") )
              ((and (< 0.6 LMRad)(< LMRand 0.8))(princ "Got that, thanks. ") )
              (T (princ "Awesome. ") )
           ) ; end cond
  (setq enta (car result))

  (setq pt (cdr (assoc 10 (entget enta))) )
;;;;fix for nenset or entsel requirements
  (setq entb (last (last (nentselp pt))))
  (if (not (wcmatch "*DIM*" Enttype) ) ; don't nest these entity types
    (if (and (/= entb nil) (/= (type entb) 'real) )
      (progn
        (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb))
      )
    )
  )
  (setq endloop "Yes")
          ) ; end progn
        ) ; end if
      )
      ( (or (= "Exit" result)(= "E" result))
        (princ "\n-Cancel or Exit- ")
      )
      ( (= nil result) ;; Missed
        (if (= LP (getvar "lastpoint"))(princ)(princ (strcat "\nMissed: Select " Enttype ", do try again. Carefully. ")));
      )
      (t
        (princ ". Sorry, forgot, you're ending the selection. ")
        (setvar "errno" 52)
      )
    ) ; end conds
  ) ; end while

  enta ;;Entity name
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gettextdxfcodes ( entlist1 / dxfcodes)
;;DXF codes containing texts
  (setq dxfcodes (list 3 4 1 172 304)) ;;general

  (if (= (cdr (assoc 0 entlist1)) "DIMENSION") ;;If Dimension
    (progn
      (if (= (cdr (assoc 1 entlist1)) nil)
        (setq dxfcodes (list 4 42 172 304)) ;;No 3, add 42 for dimension value
        (if (and (= (wcmatch "<>" (cdr (assoc 1 entlist1))) nil)(= (wcmatch "\"\"" (cdr (assoc 1 entlist1))) nil) )
          (setq dxfcodes (list 4 1 172 304)) ;;No 3, no 42 for dimension value
          (setq dxfcodes (list 4 1 42 172 304)) ;;Somehow combine 1 and 42 here, text replace and so on.
        ) ;end if
      ) ;end if
  ));end progn end if Dimensions

  (if (= (cdr (assoc 0 entlist1)) "MULTILEADER") ;;Is MultiLeader
    (progn
      (setq dxfcodes (list 304))
  ));end progn end if Dimensions
  dxfcodes
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;get text as a string
(defun gettextasstring ( enta entcodes / texta )
  (if (= (getfroment enta "astring" entcodes) "")
    ()
    (setq texta (getfroment enta "astring" entcodes))
  )
  texta
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun compareentities (ent1 ent2 / mycount msg)
  (setq mycount 0)
  (while (equal (entget ent1) (entget ent2))
    (progn
      (setq mycount (+ mycount 1))
      (princ "\n-- Text 1 and Text 2 are the same. Please select text 2 again.")
      (setq msg (strcat "\nSelect Text 2 : {" (rtos mycount) "}" ) )
      (setq ent2 (getent msg "TEXT,MTEXT,ATTRIB"))
    )
  )
  ent2
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dimensionfix ( ent1 entlist1 entlist2 text01 deldim / )
  (if (= "DIMENSION" (cdr (assoc 0 entlist1)))
    (progn
      (if (= deldim "del") (txtcleardim ent1 entlist1) )
      (if (and (/= "DIMENSION" (cdr (assoc 0 entlist2)))(= text01 nil))(setq text01 (gettextasstring ent1 (list 42))))
    )
  )
  text01
)
(defun txtcleardim (ent1 entlist1 / )
  (if (= "DIMENSION" (cdr (assoc 0 entlist1)))
    (progn
      (entmod (deletedxfdata ent1 entlist1 (list 1)))
      (entupd ent1)
    )
    (princ "Thats Not a dimension....")
  )
)
(defun deletedxfdata ( delent delentlist entcodes / acount acounter )
  (setq acounter 0)
  (setq acount 0)
  (while (< acount (length entcodes))
    (while (< acounter (length delentlist))
      (if (= (car (nth acounter delentlist) ) (nth acount entcodes) )
        (progn
          (entmod (setq delentlist (subst (cons (nth acount entcodes) "") (nth acounter delentlist) delentlist)))
          (entupd delent)
        )
      )
      (setq acounter (+ acounter 1))
    );end while
   (setq acount (+ acount 1))
  );end while
  delentlist
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun addinnewtext (newtext newentlist newent / )

;; Set to single line text for block attributes
;;https://forums.autodesk.com/t5/autocad-forum/remove-carriage-return/
  (if (and
      (= (cdr (assoc 0 newentlist)) "ATTRIB") ; attribute
      (wcmatch newtext "*\\P*"); contains any carriage return
    ) ; end and
    (while (wcmatch newtext "*\\P*"); then
      (setq newtext (vl-string-subst " " "\\P" newtext))
    ); while
  ); if

  (if (/= newtext nil)
    (progn
      (cond
        ( (= (cdr (assoc 0 newentlist)) "DIMENSION")
          (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist)))
          (entupd newent)
        );end condition

        ( (= (cdr (assoc 0 newentlist)) "RTEXT")
          (princ "\nRtext: Unwilling to update source file (")
          (princ (cdr (assoc 1 newentlist)) )
          (princ ")")
        );end condition



;Fix here for attdef or attrib to be dxf code 2

        (t ;everything else
;;vla-put-text string for large text blocks + 2000 characters?
          (vla-put-textstring (vlax-ename->vla-object newent) newtext)
        );end condition
      ) ;end cond
    ) ;end progn
    (princ "\nSource text is not 'text'")
  );end if
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;








;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ctx( / entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter explist)

;;get text 1
  (setq ent1 (getent "\nSelect New Text : " "TEXT,MTEXT,ATTRIB,*LEADER,DIMENSION"))
  (setq entlist1 (entget ent1))
  (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
  (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string

;;loop till cancelled
  (while (/=  "" (setq ent2 (getent "\nSelect Text To Change or escape: " "TEXT,MTEXT,ATTRIB,*LEADER,DIMENSION")))

;;get text 2
    (setq ent2 (compareentities ent1 ent2))
    (setq entlist2 (entget ent2))
    (setq entcodes2 (gettextdxfcodes entlist2)) ;;reset entcodes
    (setq text02 (gettextasstring ent2 entcodes2) )

;;delete text except for basic DXF code 1
;;Needed if using entmod method, not VLA-PUT-TEXTSTRING method
    (setq entlist2 (deletedxfdata ent2 entlist2 entcodes2))

;;fix for dimensions
    (Setq text01 (dimensionfix ent1 entlist1 entlist2 text01 "keep"))
    (Setq text02 (dimensionfix ent2 entlist2 entlist1 text02 "keep"))

;;;put in new text
    (addinnewtext text01 entlist2 ent2)

    (command "redraw")
    (command "regen") ;;update it all
  );end while

;;Finalise
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;