Copy text value to another entity not working

#1
Another .lsp file that worked in Autocad 2018 but not in IntelliCAD. It doesn't give any errors, just doesn't work, pretty sure it's a syntax difference. r2.lsp should copy text value from text/mtext/& more to another entity.
Quan? Anyone? It won't let me drag n drop into here or attach .lsp extension so here it is pasted in: Thanks!

Code: Select all

;; From msclout72 https://forums.autodesk.com/t5/user/viewprofilepage/user-id/437073
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/use-table-data-in-mtext-or-multileader/td-p/2568480
;;; TTC - Text to Text copy. Copy text from DIMENSION, TEXT, MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one
;; Line 212 )T?
;; Change ttc to ct then to r2, make Pair-wise the default. In a session, it remembers Continuous (Source to Multi like read Anvil) or Pair (runs like read original, long ago) ~RLH
(defun c:r2 (/ actDoc vlaObj sObj sText curObj oldForm
oType oldMode conFlag errFlag *error*)
(vl-load-com)
(setq actDoc(vla-get-ActiveDocument
(vlax-get-acad-object)))
(vla-StartUndoMark actDoc)
(defun ct_Paste(pasteStr / nslLst vlaObj hitPt
hitRes Row Column)
(setq errFlag nil)
(if
(setq nslLst(nentsel "\nPaste text >"))
(progn
(cond
(
(and
(= 4(length nslLst))
(= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))
); end and
(setq vlaObj
(vlax-ename->vla-object
(cdr(assoc -1(entget(car(last nslLst)))))))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-TextOverride(list vlaObj pasteStr)))
(progn
(princ "\n Can't paste. Object may be on locked layer. ")
(setq errFlag T)
); end progn
); end if
); end condition #1
(
(and
(= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))
); end and
(setq vlaObj
(vlax-ename->vla-object
(cdr(assoc -1(entget(car(last nslLst))))))
hitPt(vlax-3D-Point(trans(cadr nslLst)1 0))
hitRes(vla-HitTest vlaObj hitPt
(vlax-3D-Point '(0.0 0.0 1.0)) 'Row 'Column)
); end setq
(if(= :vlax-true hitRes)
(progn
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-SetText(list vlaObj Row Column pasteStr)))
(progn
(princ "\n Can't paste. Object may be on locked layer. ")
(setq errFlag T)
); end progn
); end if
); end progn
); end if
); end condition # 2
(
(and
(= 4(length nslLst))
(= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))
); end and
(princ "\nCan't paste to block's DText or MText. Select Attribute ")
(setq errFlag T)
); end condition #3
(
(and
(= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst))))
'("TEXT" "MTEXT" "ATTRIB" "ATTDEF" "MULTILEADER"))
); end and
(setq vlaObj
(vlax-ename->vla-object(car nslLst)))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-TextString(list vlaObj pasteStr)))
(progn
(princ "\nError. Can't pase text. ")
(setq errFlag T)
); end progn
); end if
); end condition #4
(T
(princ "\nCan't paste. Invalid object. ")
(setq errFlag T)
); end condition #5
); end cond
T
); end progn
nil
); end if
); end of ct_Paste

(defun ct_MText_Clear(Mtext / Text Str)
(setq Text "")
(while(/= Mtext "")
(cond
((wcmatch
(strcase
(setq Str
(substr Mtext 1 2)))
"\\[\\{}`~]")
(setq Mtext(substr Mtext 3)
Text(strcat Text Str)
); end setq
); end condition #1
((wcmatch(substr Mtext 1 1) "[{}]")
(setq Mtext
(substr Mtext 2))
); end condition #2
(
(and
(wcmatch
(strcase
(substr Mtext 1 2)) "\\P")
(/=(substr Mtext 3 1) " ")
); end and
(setq Mtext (substr Mtext 3)
Text (strcat Text " ")
); end setq
); end condition #3
((wcmatch
(strcase
(substr Mtext 1 2)) "\\[LOP]")
(setq Mtext(substr Mtext 3))
); end condition #4
((wcmatch
(strcase
(substr Mtext 1 2)) "\\[ACFHQTW]")
(setq Mtext
(substr Mtext
(+ 2
(vl-string-search ";" Mtext))))
); end condition #5
((wcmatch
(strcase (substr Mtext 1 2)) "\\S")
(setq Str(substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
Text(strcat Text (vl-string-translate "#^\\" " " Str))
Mtext(substr Mtext (+ 4 (strlen Str)))
); end setq
(print Str)
); end condition #6
(T
(setq Text(strcat Text(substr Mtext 1 1))
Mtext (substr Mtext 2)
)
); end condition #7
); end cond
); end while
Text
); end of ct_MText_Clear

(defun ct_Copy (/ sObj sText tType actDoc)
(if
(and
(setq sObj(car(nentsel "\nCopy text... ")))
(member(setq tType(cdr(assoc 0(entget sObj))))
'("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))
); end and
(progn
(setq actDoc(vla-get-ActiveDocument
(vlax-get-Acad-object))
sText(vla-get-TextString
(vlax-ename->vla-object sObj))
); end setq
(if(= tType "MTEXT")
(setq sText(ct_MText_Clear sText))
); end if
); end progn
); end if
sText
); end of ct_Copy
(defun CCT_Str_Echo(paseStr / comStr)
(if(< 20(strlen paseStr))
(setq comStr
(strcat
(substr paseStr 1 17)"..."))
(setq comStr paseStr)
); end if
(princ
(strcat "\nText = \"" comStr "\""))
(princ)
); end of CCT_Str_Echo
(defun *error*(msg)
(vla-EndUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(princ "\nQuit ct")
(princ)
); end of *error*
(if(not ct:Mode)(setq ct:Mode "Multiple"))
(initget "Multiple Pair")
(setq oldMode ct:Mode
ct:Mode
(getkword
(strcat "\nSpecify mode [Multiple/Pair] <" ct:Mode ">: "))
conFlag T
paseStr ""
); end setq
(if(null ct:Mode)(setq ct:Mode oldMode))
(if(= ct:Mode "Multiple")
(progn
(if(and(setq paseStr(ct_Copy))conFlag)
(progn
(CCT_Str_Echo paseStr)
(while(setq conFlag(ct_Paste paseStr))T)
; end while
); end progn
); end if
); end progn
(progn
(while
(and conFlag paseStr)
(setq paseStr(ct_Copy))
(if(and paseStr conFlag)
(progn
(CCT_Str_Echo paseStr)
(setq errFlag T)
(while errFlag
(setq conFlag(ct_Paste paseStr))
);end while
); end progn
); end if
); end while
); end progn
); end if
(vla-EndUndoMark actDoc)
(princ "\nQuit ct")
(princ)
); end c:ct
(princ "\n\t ct - Copy Text. Copy text from DIMENSION, TEXT, MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one")
33+ years using Autocad, wanting to fully learn iCad and share my knowledge of applicable crossover info from Acad.
-=(RLH)=-

Re: Copy text value to another entity not working

#2
Hi Hamn,
Here's the modified. it accepts Text/Mtext and Dimension.
(because of some vl-* functions not work in IntelliCAD)

Code: Select all

;; From msclout72 https://forums.autodesk.com/t5/user/viewprofilepage/user-id/437073
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/use-table-data-in-mtext-or-multileader/td-p/2568480
;;; TTC - Text to Text copy. Copy text from DIMENSION, TEXT, MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one
;; Line 212 )T?
;; Change ttc to ct then to r2, make Pair-wise the default. In a session, it remembers Continuous (Source to Multi like read Anvil) or Pair (runs like read original, long ago) ~RLH
(defun c:r2 (/ actDoc vlaObj sObj sText curObj oldForm oType oldMode conFlag errFlag *error*)
  (vl-load-com)
  (setq actDoc(vla-get-ActiveDocument(vlax-get-acad-object)))
  (vla-StartUndoMark actDoc)

  (defun ct_Paste(pasteStr / nslLst vlaObj hitPt hitRes Row Column)
    (setq errFlag nil)
    (if
      (setq nslLst(nentsel "\nPaste text >"))
      (progn	
	(cond
	  ( (and (= 4(length nslLst))
		 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))
		 ); end and
	   (setq vlaObj (vlax-ename->vla-object(cdr(assoc -1(entget(car(last nslLst)))))))
	   (vla-put-TextOverride vlaObj pasteStr)
;;;	   (if
;;;	     (vl-catch-all-error-p
;;;	       (vl-catch-all-apply
;;;		 'vla-put-TextOverride(list vlaObj pasteStr)))
;;;	     (progn
;;;	       (princ "\n Can't paste. Object may be on locked layer. ")
;;;	       (setq errFlag T)
;;;	       ); end progn
;;;	     ); end if
	   ); end condition #1
;;;	  ( (and
;;;	      (= 4(length nslLst))
;;;	      (= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))
;;;	      ); end and
;;;	   (setq vlaObj(vlax-ename->vla-object(cdr(assoc -1(entget(car(last nslLst))))))
;;;		 hitPt(vlax-3D-Point(trans(cadr nslLst)1 0))
;;;		 hitRes(vla-HitTest vlaObj hitPt
;;;			 (vlax-3D-Point '(0.0 0.0 1.0)) 'Row 'Column)
;;;		 ); end setq
;;;	   (if(= :vlax-true hitRes)
;;;	     (progn
;;;	       (if (vl-catch-all-error-p
;;;		     (vl-catch-all-apply
;;;		       'vla-SetText(list vlaObj Row Column pasteStr)))
;;;		 (progn
;;;		   (princ "\n Can't paste. Object may be on locked layer. ")
;;;		   (setq errFlag T)
;;;		   ); end progn
;;;		 ); end if
;;;	       ); end progn
;;;	     ); end if
;;;	   ); end condition # 2
	  ( (and
	      (= 4(length nslLst))
	      (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))
	      ); end and
	   (princ "\nCan't paste to block's DText or MText. Select Attribute ")
	   (setq errFlag T)
	   ); end condition #3
	  ( (and
	      (= 2(length nslLst))
	      (princ (strcat "\n"(cdr(assoc 0(entget(car nslLst))))))
	      (member(cdr(assoc 0(entget(car nslLst))))
		     '("TEXT" "MTEXT")); "ATTRIB" "ATTDEF" "MULTILEADER"))
	      ); end and
	   (setq vlaObj(vlax-ename->vla-object(car nslLst)))
	   (vla-put-TextString  vlaObj pasteStr)
;;;	   (if
;;;	     (vl-catch-all-error-p
;;;	       (vl-catch-all-apply
;;;		 'vla-put-TextString(list vlaObj pasteStr)))
;;;	     (progn
;;;	       (princ "\nError. Can't pase text. ")
;;;	       (setq errFlag T)
;;;	       ); end progn
;;;	     ); end if
	   
	   ); end condition #4
	  (T (princ "\nCan't paste. Invalid object. ")
	   (setq errFlag T)
	   ); end condition #5
	  ); end cond
	T
	); end progn
      nil
      ); end if
    ); end of ct_Paste


  (defun ct_MText_Clear(Mtext / Text Str)
    (setq Text "")
    (while(/= Mtext "")
      (cond
	( (wcmatch(strcase(setq Str(substr Mtext 1 2)))"\\[\\{}`~]")
	 (setq Mtext(substr Mtext 3)
	       Text(strcat Text Str)
	       ); end setq
	 ); end condition #1

	((wcmatch(substr Mtext 1 1) "[{}]")
	 (setq Mtext (substr Mtext 2))
	 ); end condition #2

	( (and
	    (wcmatch(strcase(substr Mtext 1 2)) "\\P")
	    (/=(substr Mtext 3 1) " ")
	    ); end and
	 (setq Mtext (substr Mtext 3)
	       Text (strcat Text " ")
	       ); end setq
	 ); end condition #3

	( (wcmatch(strcase(substr Mtext 1 2)) "\\[LOP]")
	 (setq Mtext(substr Mtext 3))
	 ); end condition #4

	( (wcmatch(strcase(substr Mtext 1 2)) "\\[ACFHQTW]")
	 (setq Mtext(substr Mtext(+ 2(vl-string-search ";" Mtext))))
	 ); end condition #5
	
	( (wcmatch (strcase (substr Mtext 1 2)) "\\S")
	 (setq Str(substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
	       Text(strcat Text (vl-string-translate "#^\\" " " Str))
	       Mtext(substr Mtext (+ 4 (strlen Str)))
	       ); end setq
	 (print Str)
	 ); end condition #6
	
	(T (setq Text(strcat Text(substr Mtext 1 1))
		 Mtext (substr Mtext 2))
	 ); end condition #7
	); end cond
      ); end while
    Text
    ); end of ct_MText_Clear


  (defun ct_Copy (/ sObj sText tType actDoc)
    (if (and
	  (setq sObj(car(nentsel "\nCopy text... ")))
	  (member(setq tType(cdr(assoc 0(entget sObj))))
		 '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
      (progn
	(setq actDoc(vla-get-ActiveDocument(vlax-get-Acad-object))
	      sText(vla-get-TextString(vlax-ename->vla-object sObj))
	      ); end setq

	(if(= tType "MTEXT")
	  (setq sText(ct_MText_Clear sText))
	  ); end if
	); end progn
      ); end if
    sText
    ); end of ct_Copy
  

  (defun CCT_Str_Echo(paseStr / comStr)
    (if(< 20(strlen paseStr))
      (setq comStr(strcat(substr paseStr 1 17)"..."))
      (setq comStr paseStr)
      ); end if
    (princ(strcat "\nText = \"" comStr "\""))
    (princ)
    ); end of CCT_Str_Echo

  
  (defun *error*(msg)
    (vla-EndUndoMark(vla-get-ActiveDocument(vlax-get-acad-object)))
    (princ "\nQuit ct")
    (princ)
    ); end of *error*
  

  (if(not ct:Mode)(setq ct:Mode "Multiple"))
  (initget "Multiple Pair")
  (setq oldMode ct:Mode
	ct:Mode(getkword(strcat "\nSpecify mode [Multiple/Pair] <" ct:Mode ">: "))
	conFlag T
	paseStr ""
	); end setq
  (if(null ct:Mode)(setq ct:Mode oldMode))
  (if(= ct:Mode "Multiple")
    (progn
      (if(and(setq paseStr(ct_Copy))conFlag)
	(progn
	  (CCT_Str_Echo paseStr)
	  (while(setq conFlag(ct_Paste paseStr))T)
	  ; end while
	  ); end progn
	); end if
      ); end progn
    (progn
      (while (and conFlag paseStr)
	(setq paseStr(ct_Copy))
	(if(and paseStr conFlag)
	  (progn
	    (CCT_Str_Echo paseStr)
	    (setq errFlag T)
	    (while errFlag
	      (setq conFlag(ct_Paste paseStr))
	      );end while
	    ); end progn
	  ); end if
	); end while
      ); end progn
    ); end if
  (vla-EndUndoMark actDoc)
  (princ "\nQuit ct")
  (princ)
  ); end c:ct

;(princ "\n\t ct - Copy Text. Copy text from DIMENSION, TEXT, MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one")

Re: Copy text value to another entity not working

#6
I also have this code that almost does it all, it copies values:
From/to mtext & text to mtext, text & multi-leader
From text and text attribute in block to mtext, text & multileader
but not
From text and text attribute multi-leader into block text or block attribute
If it could copy values to a block, it would be about as good as can be, is it fixable easily Quan?
Code:

;; was kopirujtext/lsp language=Czech
;; Kopie textu ze zdrojové textové entity na cílové entity (ve stejném prostoru)
;; (copy text content from a source text entity to target text entities [in the same space])
;; z www.cadforum.cz (Pajas+Hadraba)
;;
(defun C:READ (/ sel text blky jb te s_jba at atr)
(while (not sel)
(princ "\n*** Select Source text: ")
(setq sel (entget (car (nentsel))))
(if (and (/= (cdr (assoc 0 sel)) "TEXT")
(/= (cdr (assoc 0 sel)) "MTEXT")
(/= (cdr (assoc 0 sel)) "ATTDEF")
(/= (cdr (assoc 0 sel)) "ATTRIB")
(/= (cdr (assoc 0 sel)) "MULTILEADER")
)
(progn
(prompt
"\n*** The selected entity is not a text, mtext, multileader or attribute."
)
(setq sel nil)
)
sel
)
)
(if (or (= (cdr (assoc 0 sel)) "TEXT")
(= (cdr (assoc 0 sel)) "MTEXT")
(= (cdr (assoc 0 sel)) "ATTRIB")
)
(setq text (cdr (assoc 1 sel)))
(setq text (cdr (assoc 2 sel)))
)
(if (= (cdr (assoc 0 sel)) "MULTILEADER")
(setq text (cdr (assoc 304 sel)))
)
(princ text)
(princ
"\n*** Select item to copy new text: "
)
(setq blky (ssget
'((-4 . "<OR")
(0 . "TEXT")
(0 . "MTEXT")
(0 . "ATTDEF")
(0 . "MULTILEADER")
(-4 . "OR>")
)
)
)
(setq nt 0)
(repeat (sslength blky)
(setq jb (ssname blky nt)
te (cdr (assoc '0 (entget jb)))
nt (1+ nt)
)
(if (or (= "TEXT" te) (= "MTEXT" te) (= "ATTDEF" te)(= "MULTILEADER" te))
(setq s_jba (append s_jba (list (list jb jb)))
;;list of entities
)
)
)
(princ (strcat "*** Found "
(itoa (length s_jba))
" rewritable items."
)
)
;;;Numbering
(setq nt 0)
(while (< nt (length s_jba))
(setq atr (cdr (assoc '0 (entget (cadr (nth nt s_jba))))))
(if (or (= atr "TEXT") (= atr "MTEXT"))
(setq at
(subst
(cons 1 text)
(assoc '1 (entget (cadr (nth nt s_jba))))
(entget (cadr (nth nt s_jba)))
)
)
(if (= atr "MULTILEADER")
(setq at
(subst
(cons 304 text)
(assoc '304 (entget (cadr (nth nt s_jba))))
(entget (cadr (nth nt s_jba)))
)
)
(setq at
(subst
(cons 2 text)
(assoc '2 (entget (cadr (nth nt s_jba))))
(entget (cadr (nth nt s_jba)))
)
)
)
)
(entmod at)
(entupd (car (nth nt s_jba)))
(setq nt (1+ nt))
)
(princ)
)

Thanks!

QuanNguyen wrote:
Mon Feb 08, 2021 7:39 pm
Hi Hamn,
Thank you for the good words.
The multi-leader object is more complex.
Regards.
33+ years using Autocad, wanting to fully learn iCad and share my knowledge of applicable crossover info from Acad.
-=(RLH)=-