Text copy w/ matchprops

[Nobull84]

Hello all,

 

Could anyone tell me how to alter this code? It asks to pick a value then whether to apply it once or multiple times. In multiple mode, you still only choose one at a time. I would like to be able to apply to multiple objects at once, using a selection box.

 

Thanks

-Nobull

 

;;;;Realization {Smirnoff}
;;; TTCM - Text to Text copy whith Matchprop. Copy text from DIMENSION, TEXT, 
;;;MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one
(defun c:tt (/ actDoc vlaObj sObj sText curObj oldForm
       oType oldMode conFlag errFlag *error* prop)
 (vl-load-com)
     (setq actDoc(vla-get-ActiveDocument
       (vlax-get-acad-object)))
     (vla-StartUndoMark actDoc)
 (defun TTC_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"))
      ); 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
   (if (and (null errFlag)
            (= (type vlaObj) 'VLA-OBJECT))
   (mapcar '(lambda (x y) (vlax-put-property vlaObj x y))
       '(Linetype LineWeight Color Layer)
       prop
       )
     )
            T
     ); end progn
           nil
          ); end if
   ); end of TTC_Paste
   (defun TTC_MText_Clear(Mtext / Text Str)
   (setq Text "")
   (while(/= Mtext "")
     (cond
 ((wcmatch
    (strcase
      (setq Str
       (substr Mtext 1 2)))
                    "[url="file://\\"]\\[/url][\\{}`~]")
  (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)) "[url="file://\\P"]\\P[/url]")
  (/=(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)) "[url="file://\\"]\\[/url][LOP]")
   (setq Mtext(substr Mtext 3))
 ); end condition #4
 ((wcmatch
    (strcase
      (substr Mtext 1 2)) "[url="file://\\"]\\[/url][ACFHQTW]")
   (setq Mtext
    (substr Mtext
      (+ 2
         (vl-string-search ";" Mtext))))
 ); end condition #5
 ((wcmatch
    (strcase (substr Mtext 1 2)) "[url="file://\\S"]\\S[/url]")
   (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 TTC_MText_Clear
 (defun TTC_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(TTC_MText_Clear sText))
 ); end if
     ); end progn
   ); end if
 (setq prop (mapcar '(lambda (x)
            (vlax-get-property (vlax-ename->vla-object sObj)  x))
     '(Linetype LineWeight Color Layer)
         )
       )
   sText
   ); end of TTC_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 TTCM")
   (princ)
   ); end of *error*
   (if(not ttc:Mode)(setq ttc:Mode "Multiple"))
   (initget "Multiple Pair-wise")
   (setq oldMode ttc:Mode
   ttc:Mode
    (getkword
      (strcat "\nSpecify mode [Multiple/Pair-wise] <" ttc:Mode ">: "))
   conFlag T
   paseStr ""
    ); end setq
   (if(null ttc:Mode)(setq ttc:Mode oldMode))
   (if(= ttc:Mode "Multiple")
     (progn
 (if(and(setq paseStr(TTC_Copy))conFlag)
   (progn
   (CCT_Str_Echo paseStr)
   (while(setq conFlag(TTC_Paste paseStr))T
     ); end while
   ); end progn
   ); end if
 ); end progn
     (progn
 (while
   (and conFlag paseStr)
   (setq paseStr(TTC_Copy))
   (if(and paseStr conFlag)
     (progn
   (CCT_Str_Echo paseStr)
   (setq errFlag T)
   (while errFlag
   (setq conFlag(TTC_Paste paseStr))
        );end while
      ); end progn
     ); end if
   ); end while
 ); end progn
     ); end if
  (vla-EndUndoMark actDoc)
  (princ "\nQuit TTCM")
 (princ)
 ); end c:ttc
(princ "\n\t TTCM - Text to Text copy with matchprop.")
(princ "\nCopy text from DIMENSION, TEXT, MTEXT, ATTRIB, ATTDEF, ACAD_TABLE to one")

[Lee Mac]

Here's an old program of mine which may help: Copy or Swap Text

[Nobull84]

Here's an old program of mine which may help: Copy or Swap Text

 

Thanks for the updated lisp. Old one was ok but yours does the trick. Kudos!

 

Thanks again,

-Nobull

[Lee Mac]

You're welcome - its also an old program, but I'm glad its still useful

[Nobull84]

Here's an old program of mine which may help: Copy or Swap Text

 

This lisp has been working great but two adjustments would really make this one the bees knees for myself and maybe a couple coworkers.

1. Is there any way to default the "multiple" paste function and maybe either have single paste be the selection or not at all? I've been using this rather significantly and it seems I've never had the need for this once.

2. It seems I can't use this to paste override dimensions? Is there a way to enable that? For example, there are times that I need to replace a dimension with "? E.O.S." and a cloud around it. If I could do this once and be able to copy/paste the rest would be really nice.

 

Thanks,

-Nobull