Zorg 发表于 2022-7-6 14:26:51

匹配文本-文本开关

我有这个代码来匹配多行文字，文字，属性等。。
 
(defun c:tw(/ cEnt mEnt)
(if (and (setq cEnt (car (nentsel "\nSelect Source Text: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("TEXT" "MTEXT" "ATTRIB")))
   (progn
   (redraw cEnt 3)
   (while (and (setq mEnt (car (nentsel "\nSelect Destination Text: ")))
               (member (cdr (assoc 0 (entget mEnt)))
                         '("TEXT" "MTEXT" "ATTRIB")))
       (entmod (subst (assoc 1 (entget cEnt))
                      (assoc 1 (entget mEnt))
                      (entget mEnt))))
   (redraw cEnt 4))
   (princ "\n<!> Incorrect Selection <!>"))
(princ))

(defun c:mt2(/ cEnt mEnt sLst)
(if (and (setq cEnt (car (nentsel "\nSelect Source Text: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("TEXT" "MTEXT" "ATTRIB")))
   (progn
   (redraw cEnt 3)
   (if (setq ss (ssget "_X" '((-4 . "<NOT") (0 . "TEXT,MTEXT,INSERT") (-4 . "NOT>"))))
       (mapcar '(lambda (x) (redraw x 2)) (setq sLst (mapcar 'cadr (ssnamex ss)))))
   (while (and (setq mEnt (car (nentsel "\nSelect Destination Text: ")))
               (member (cdr (assoc 0 (entget mEnt)))
                         '("TEXT" "MTEXT" "ATTRIB")))
       (entmod (subst (assoc 1 (entget cEnt))
                      (assoc 1 (entget mEnt))
                      (entget mEnt)))))
   (princ "\n<!> Incorrect Selection <!>"))
(command "_regenall")
(princ))

(defun c:mt3(/ cEnt ss)
(vl-load-com)
(if (and (setq cEnt (car (nentsel "\nSelect Source Text: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("TEXT" "MTEXT" "ATTRIB")))
   (progn
   (redraw cEnt 3)
   (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
       (foreach x(vl-remove-if 'listp
                     (mapcar 'cadr (ssnamex ss)))
         (entmod (subst (assoc 1 (entget cEnt))
                        (assoc 1 (entget x))
                        (entget x))))))
   (princ "\n<!> Incorrect Selection <!>"))
(command "_regenall")
(princ))
 
我可以修改它吗？如何将文本开关与反向“文本a”和“文本B”匹配？
 
Z

wizman 发表于 2022-7-6 14:33:16

http://cadtips.cadalyst.com/notestext/switch-text

Zorg 发表于 2022-7-6 14:34:55

谢谢wizman，效果很好

wizman 发表于 2022-7-6 14:37:52

不客气，佐格，我觉得这也很方便，我们感谢作者。

Lee Mac 发表于 2022-7-6 14:41:12

你没有发现它缺少了一个子函数，即：spextm还是只有我？

Lee Mac 发表于 2022-7-6 14:45:36

这当然更好：
 
[也适用于属性]
 

;; Switch Text Valuesby Lee McDonnell
;; 08.06.2009

(defun c:stv (/ ent1 ent2 ObjLst)
(vl-load-com)
(while (not (and (setq ent1 (car (nentsel "\nSelect 1st Text or Attribute: ")))
                  (member (cdr (assoc 0 (entget ent1))) '("MTEXT" "TEXT" "ATTRIB"))))
   (princ "\nMissed, Try Again."))
(while (not (and (setq ent2 (car (nentsel "\nSelect 2nd Text or Attribute: ")))
                  (member (cdr (assoc 0 (entget ent2))) '("MTEXT" "TEXT" "ATTRIB"))))
   (princ "\nMissed, Try Again."))
(setq ObjLst (mapcar 'vlax-ename->vla-object (list ent1 ent2)))
(mapcar
   (function
   (lambda (Obj1 Str)
       (vla-put-TextString Obj1 Str))) ObjLst
   (mapcar 'vla-get-TextString (reverse ObjLst)))
(princ))

wizman 发表于 2022-7-6 14:46:04

谢谢你指点李，我放弃了那个，但奇怪的是我记得用了那个，或者可能是另一个Lisp程序。

Lee Mac 发表于 2022-7-6 14:50:39

 
嗯，对于这样一个简单的任务，代码可以压缩很多

wizman 发表于 2022-7-6 14:54:36

 
 
我用它的时候一定是在做梦，哈哈，干得好，李

Lee Mac 发表于 2022-7-6 14:56:59

 
呵呵，干杯
页: [1] 2
查看完整版本: 匹配文本-文本开关