Jump to content
Nobull84

Text copy w/ matchprops

Recommended Posts

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")

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
Lee Mac

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

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites

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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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.


×
×
  • Create New...