社区 › Auto Lisp › 复制块内的文本

Freerefill 发表于 2022-7-6 14:38:36

复制块内的文本

我昨晚睡得不多，我知道有一个简单的方法可以做到这一点。。。
 
复制文本的简单方法是什么？我知道“Ctrl+C”，实际上我在要求一些不同的东西。使用（nentsel）（谢谢李^。^）可以获得被阻止文本位的数据。。如果要在完全相同的位置创建一段大小和内容完全相同的新文本。。现在，我创建了一段新的文本，然后匹配VLA属性，比如，
 
（vla put InsertionPoint lasEnt（vla get InsertionPoint ent））
 
我对每一个必要的属性都这样做。。有更好的方法吗？（命令“copy”）是否适用于此，即使它是填充在块中的文本？
 
谢谢^。^

Commandobill 发表于 2022-7-6 15:14:15

实际上，我这个周末创建了一个lisp。。。那么，您希望只复制文本还是嵌套在块中的文本？因为如果只是文本，我会考虑copybase。如果没有，我可以在早上给你Lisp程序

Lee Mac 发表于 2022-7-6 15:34:39

当你说“复制一个属性”时，如果你想返回一个新属性，那么我只是在胡闹：
 

(defun c:ctxt(/ doc spc tEnt tObj)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
(if (and (setq tEnt (car (nentsel "\nSelect Text Object: ")))
          (member (cdadr (entget tEnt))
                  '("TEXT" "MTEXT" "ATTRIB")))
   (progn
   (setq tObj (vlax-ename->vla-object tEnt))
   (cond ((member (cdadr (entget tEnt)) '("TEXT" "MTEXT"))
            (vla-move
            (vla-copy tObj)
                (vla-get-InsertionPoint tObj)
                  (vlax-3D-point
                  (getpoint "\nSelect New Location: "
                      (cdr (assoc 10 (entget tEnt)))))))
         (T
            (vla-move
            (vla-addAttribute spc
                (vla-get-Height tObj) 0
                  (vla-get-TagString tObj)
                  (vla-get-InsertionPoint tObj)
                      (vla-get-TagString tObj) "")
                        (vla-get-InsertionPoint tObj)
                        (vlax-3D-point
                            (getpoint "\nSelect New Location: "
                              (vlax-safearray->list
                              (vlax-variant-value
                                  (vla-get-InsertionPoint tObj)))))))))
   (princ "\n<!> Incorrect Selection <!>"))
(princ))

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

我猜你更喜欢这样的事情：
 

(defun c:ctxt(/ doc spc tEnt tObj mtxt)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
(if (and (setq tEnt (car (nentsel "\nSelect Text Object: ")))
          (member (cdadr (entget tEnt))
                  '("TEXT" "MTEXT" "ATTRIB")))
   (progn
   (setq tObj (vlax-ename->vla-object tEnt))
   (cond ((member (cdadr (entget tEnt)) '("TEXT" "MTEXT"))
            (vla-move
            (vla-copy tObj)
                (vla-get-InsertionPoint tObj)
                  (vlax-3D-point
                  (getpoint "\nSelect New Location: "
                      (cdr (assoc 10 (entget tEnt)))))))
         (T
            (setq mtxt
            (vla-addMText spc
                (vla-get-InsertionPoint tObj) 0
                  (vla-get-TextString tObj)))
            (vla-put-layer mtxt (vla-get-layer tObj))
            (vla-put-StyleName mtxt (vla-get-StyleName tObj))
                (vla-put-color mtxt (vla-get-color tObj))
                  (vla-put-height mtxt (vla-get-height tObj))
            (vla-move mtxt
            (vla-get-InsertionPoint mtxt)
                (vlax-3D-point
                  (getpoint "\nSelect New Location: "
                  (vlax-safearray->list
                      (vlax-variant-value
                        (vla-get-InsertionPoint mtxt)))))))))
   (princ "\n<!> Incorrect Selection <!>"))
(princ))

查看完整版本: 复制块内的文本