匹配文本-文本开关

Zorg · 发表于 2022-7-6 14:59:10

哇，太好了！他们两个，今天下午都要尝试一下，不过李的似乎最靠谱：眨眼：

再次感谢各位

Z

Lee Mac · 发表于 2022-7-6 15:02:24

干杯，伙计

alanjt · 发表于 2022-7-6 15:06:47

哎哟，你把我割得很深，史瑞克

Lee Mac · 发表于 2022-7-6 15:09:49

你的也不错Alan

Lee Mac · 发表于 2022-7-6 15:12:07

Zorg，试试这个

copy


[i][color=#990099];; Switch/Match Text Values  by Lee McDonnell[/color][/i]
[i][color=#990099];; 09.06.2009[/color][/i]
[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:tv [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] ent1 ent2 Str ss[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent1 [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]nentsel[/color][/b] [b][color=#ff00ff]"\nSelect Source Text: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]member[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] ent1[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                  [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#ff00ff]"MTEXT"[/color][/b][b][color=#ff00ff]"TEXT"[/color][/b][b][color=#ff00ff]"ATTRIB"[/color][/b][b][color=#ff00ff]"MLEADER"[/color][/b][b][color=#ff00ff]"ATTDEF"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\nMissed, Try Again. "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]initget[/color][/b] [b][color=#ff00ff]"Match"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent2 [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Text to Swap or <Match> : "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-consp[/color][/b] ent2[b][color=RED])[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]member[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] ent2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                         [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#ff00ff]"MTEXT"[/color][/b][b][color=#ff00ff]"TEXT"[/color][/b][b][color=#ff00ff]"ATTRIB"[/color][/b][b][color=#ff00ff]"MLEADER"[/color][/b][b][color=#ff00ff]"ATTDEF"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent2 [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] ent2[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE]nil[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] ent2[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=DARKRED]'[/color][/b]STR [b][color=RED]([/color][/b][b][color=BLUE]type[/color][/b] ent2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"*TEXT,ATTRIB,MLEADER,ATTDEF"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE]nil[/color][/b] [b][color=BLUE]t[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]T[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\nMissed, Try Again..."[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Str [b][color=RED]([/color][/b][b][color=BLUE]vla-get-TextString[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] ent1[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]  
 [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]ss
        [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]vla-put-TextString[/color][/b] x Str[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b]
                  [b][color=RED]([/color][/b][b][color=BLUE]vl-remove-if[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]listp[/color][/b]
                    [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]cadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssnamex[/color][/b] ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b]ent2
        [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Objlst [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] ent1 ent2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
        [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]Obj1 Str[b][color=RED])[/color][/b]
              [b][color=RED]([/color][/b][b][color=BLUE]vla-put-TextString[/color][/b] Obj1 Str[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] ObjLst
          [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]vla-get-TextString[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]reverse[/color][/b] ObjLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

alanjt · 发表于 2022-7-6 15:15:02

哈哈，谢谢。

alanjt · 发表于 2022-7-6 15:19:49

您应该用vl consp替换cond中的listp检查。如果变量为零，listp将返回T。现在，如果你错过了一个目标对象，它就会出错。当然，如果你错过了一个选择，这仍然会切换ssget&matching。

Lee Mac · 发表于 2022-7-6 15:22:32

非常感谢Alan提供的提示，我不知道listp在提供nil参数时返回了T。

我会改变的

编辑：以上代码已更新~再次感谢Alan查看

Zorg · 发表于 2022-7-6 15:25:29

在你们俩之间，我想你们可以自己动手

再次感谢各位

Z

JeepMaster · 发表于 2022-7-6 15:29:48

佐尔格，
对这两个伟大的家伙没有冒犯之意，但来自asmi的这一个甚至更好。它也可以从动态块属性交叉匹配到常规文本。我不能从中获得任何荣誉，因为它是由ASMI创建的。

copy

;; ============================================================    ;;
;;                                                              ;;
;;  TTC.LSP - The program copies the text from: DText, MText,     ;;
;;            Tables, Dimensions, Attributes, Attributes,    ;;
;;            Attributes Definitions, DText, MText and inner    ;;
;;          block's DText and MText to: DText, MText, Tables,    ;;
;;          Attribures and Attributes Definitions. There are    ;;
;;           Multiple and Pair-wise modes.             ;;
;;                                                              ;;
;; ============================================================    ;;
;;                                                                ;;
;;  Command(s) to call: TTC                                       ;;
;;                                                              ;;
;; ============================================================    ;;
;;                                                                 ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD    ;;
;;  ON ANY MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS    ;;
;;  PROGRAM OR PARTS OF IT ABSOLUTELY FREE.                     ;;
;;                                                              ;;
;;  THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS    ;;
;;  AND SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF        ;;
;;  MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.            ;;
;;                                                                ;;
;; ============================================================    ;;
;;                                                              ;;
;;  V1.3, 29 November, 2005, Riga, Latvia                         ;;
;;  © Aleksandr Smirnov (ASMI)                              ;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions)    ;;
;;                                                              ;;
;;                             http://www.asmitools.com       ;;
;;                                                              ;;
;; ============================================================ ;;
(defun c:ttc (/ 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 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 "\n<!> Can't paste to block's DText or MText <!> ")
           (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 "\n<!> Error. Can't pase text <!> ")
              (setq errFlag T)
            ); end progn
           ); end if
         ); end condition #4
       (T
         (princ "\n<!> Can't paste. Invalid object <!> ")
         (setq errFlag T)
        ); end condition #5
       ); end cond
             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)))"\\[\\{}`~]")
           (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 setq
        ); 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
   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 TTC")
   (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 TTC")
 (princ)
 ); end c:ttc
(princ "\n*** Type TTC to run text to text copy tool *** ")

[编程交流] 匹配文本-文本开关

发表回复

精选推荐