LISP插入两个属性，乐筑天下 - Powered by Discuz! Archiver

Lee Mac 发表于 2022-7-6 09:56:27

啊，还有一件事，属性的标签是什么？

chelsea1307 发表于 2022-7-6 09:59:17

节点1
节点2
长
线圈

现在就试试
节点。图纸

Lee Mac 发表于 2022-7-6 10:03:46

你有2004年版的吗？

Lee Mac 发表于 2022-7-6 10:07:31

可能是这样吗？

(defun c:NdUpd(/ doc spc nd1 nd2 pl mtxt pt ndlst blk)
(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 (or (tblsearch "BLOCK" "NODE")
      (findfile "NODE.dwg"))
(if (and (setq nd1 (car (entsel "\nSelect Node 1: ")))
         (eq "INSERT" (cdadr (entget nd1)))
         (eq "PNODE" (cdr (assoc 2 (entget nd1)))))
(if (and (setq nd2 (car (entsel "\nSelect Node 2: ")))
         (eq "INSERT" (cdadr (entget nd2)))
         (eq "PNODE" (cdr (assoc 2 (entget nd2)))))
   (if (and (setq pl (car (entsel "\nSelect Line Object: ")))
            (member (cdadr (entget pl)) '("LWPOLYLINE" "POLYLINE" "LINE")))
      (if (and (setq mtxt (car (entsel "\nSelect MTEXT: ")))
               (wcmatch (cdadr (entget mtxt)) "*TEXT"))
      (if (setq pt (getpoint "\nSelect Point for Block: "))
         (progn
            (setq ndlst
            (mapcar
               (function
                  (lambda (x)
                  (cdr (assoc 1 (entget (entnext x))))))
               (list nd1 nd2)))
            (setq blk
            (vla-insertblock spc
               (vlax-3D-point (trans pt 1 0)) "NODE.dwg" 1. 1. 1. 0.))
            (foreach att(vlax-safearray->list
                           (vlax-variant-value
                              (vla-getAttributes blk)))
            (cond ((eq "NODE1" (vla-get-TagString att))
                     (vla-put-TextString att (car ndlst)))
                  ((eq "NODE2" (vla-get-TagString att))
                     (vla-put-TextString att (cadr ndlst)))
                  ((eq "LENGTH" (vla-get-TagString att))
                     (vla-put-TextString att
                     (rtos
                        (vla-get-Length
                           (vlax-ename->vla-object pl)))))
                  ((eq "COIL" (vla-get-TagString att))
                     (vla-put-TextString att
                     (cdr (assoc 1 (entget mtxt))))))))
         (princ "\n<!> No Point Selected <!>"))
      (princ "\n<!> Incorrect MTEXT Selection <!>"))
      (princ "\n<!> Incorrect LINE Object Selection <!>"))
   (princ "\n<!> Incorrect Selection of NODE 2 <!>"))
(princ "\n<!> Incorrect Selection of NODE 1 <!>"))
(princ "\n<!> NODE Block not Found <!>"))
(princ))

chelsea1307 发表于 2022-7-6 10:07:58

它适用于那些有线圈和多行文字的，但如果我没有多行文字，它会出错，有没有办法使多行文字选择可选？如果你点击它，它包括它，如果你不它跳过它，并继续？或者别的什么

chelsea1307 发表于 2022-7-6 10:10:58

你给我的代码很好用，除了我没有多行文字的情况。我试着把它取出来，给它一个新的方块（一个没有线圈斑点的方块），但它说的论点太少了，有人看到我哪里出错了吗？
(defun c:NdUpd2(/ doc spc nd1 nd2 pl mtxt pt ndlst blk)
(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 (or (tblsearch "BLOCK" "NODE2")
      (findfile "Node2.dwg"))
(if (and (setq nd1 (car (entsel "\nSelect Node 1: ")))
         (eq "INSERT" (cdadr (entget nd1)))
         (eq "PNODE" (cdr (assoc 2 (entget nd1)))))
(if (and (setq nd2 (car (entsel "\nSelect Node 2: ")))
         (eq "INSERT" (cdadr (entget nd2)))
         (eq "PNODE" (cdr (assoc 2 (entget nd2)))))
   (if (and (setq pl (car (entsel "\nSelect Line Object: ")))
            (member (cdadr (entget pl)) '("LWPOLYLINE" "POLYLINE" "LINE")))
      (if (setq pt (getpoint "\nSelect Point for Block: "))
         (progn
            (setq ndlst
            (mapcar
               (function
                  (lambda (x)
                  (cdr (assoc 1 (entget (entnext x))))))
               (list nd1 nd2)))
            (setq blk
            (vla-insertblock spc
               (vlax-3D-point (trans pt 1 0)) "Node2.dwg" 1. 1. 1. 0.))
            (foreach att(vlax-safearray->list
                           (vlax-variant-value
                              (vla-getAttributes blk)))
            (cond ((eq "NODE1" (vla-get-TagString att))
                     (vla-put-TextString att (car ndlst)))
                  ((eq "NODE2" (vla-get-TagString att))
                     (vla-put-TextString att (cadr ndlst)))
                  ((eq "LENGTH" (vla-get-TagString att))
                     (vla-put-TextString att
                     (rtos
                        (vla-get-Length))))))))
         (princ "\n<!> No Point Selected <!>"))
      (princ "\n<!> Incorrect LINE Object Selection <!>"))
   (princ "\n<!> Incorrect Selection of NODE 2 <!>"))
(princ "\n<!> Incorrect Selection of NODE 1 <!>"))
(princ "\n<!> NODE Block not Found <!>"))
(princ))

Lee Mac 发表于 2022-7-6 10:16:29

这应该提供无多行文字的选项。。。

(defun c:NdUpd(/ doc spc nd1 nd2 pl mtxt pt ndlst blk)
(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 (or (tblsearch "BLOCK" "NODE")
      (findfile "NODE.dwg"))
(if (and (setq nd1 (car (entsel "\nSelect Node 1: ")))
         (eq "INSERT" (cdadr (entget nd1)))
         (eq "PNODE" (strcase (cdr (assoc 2 (entget nd1))))))
(if (and (setq nd2 (car (entsel "\nSelect Node 2: ")))
         (eq "INSERT" (cdadr (entget nd2)))
         (eq "PNODE" (strcase (cdr (assoc 2 (entget nd2))))))
   (if (and (setq pl (car (entsel "\nSelect Line Object: ")))
            (member (cdadr (entget pl)) '("LWPOLYLINE" "POLYLINE" "LINE")))
      (if (setq pt (getpoint "\nSelect Point for Block: "))
         (progn
            (and (setq mtxt (car (entsel "\nSelect MTEXT: ")))
               (wcmatch (cdadr (entget mtxt)) "*TEXT"))
            (setq ndlst
            (mapcar
               (function
                  (lambda (x)
                  (cdr (assoc 1 (entget (entnext x))))))
               (list nd1 nd2)))
            (setq blk
            (vla-insertblock spc
               (vlax-3D-point (trans pt 1 0)) "NODE.dwg" 1. 1. 1. 0.))
            (foreach att(vlax-safearray->list
                           (vlax-variant-value
                              (vla-getAttributes blk)))
            (cond ((eq "NODE1" (vla-get-TagString att))
                     (vla-put-TextString att (car ndlst)))
                  ((eq "NODE2" (vla-get-TagString att))
                     (vla-put-TextString att (cadr ndlst)))
                  ((eq "LENGTH" (vla-get-TagString att))
                     (vla-put-TextString att
                     (rtos
                        (vla-get-Length
                           (vlax-ename->vla-object pl)))))
                  ((eq "COIL" (vla-get-TagString att))
                     (vla-put-TextString att
                     (if mtxt
                        (cdr (assoc 1 (entget mtxt))) ""))))))
      (princ "\n<!> No Point Selected <!>"))
      (princ "\n<!> Incorrect LINE Object Selection <!>"))
   (princ "\n<!> Incorrect Selection of NODE 2 <!>"))
(princ "\n<!> Incorrect Selection of NODE 1 <!>"))
(princ "\n<!> NODE Block not Found <!>"))
(princ))

chelsea1307 发表于 2022-7-6 10:18:42

这很有效。是否很难添加一个点来请求轮次并从0开始进行数字插入？我可以将其添加到带标记的块中

Lee Mac 发表于 2022-7-6 10:23:21

不太难

(defun c:NdUpd(/ doc spc nd1 nd2 pl mtxt pt ndlst blk turns)
(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 (or (tblsearch "BLOCK" "NODE")
      (findfile "NODE.dwg"))
(if (and (setq nd1 (car (entsel "\nSelect Node 1: ")))
         (eq "INSERT" (cdadr (entget nd1)))
         (eq "PNODE" (strcase (cdr (assoc 2 (entget nd1))))))
(if (and (setq nd2 (car (entsel "\nSelect Node 2: ")))
         (eq "INSERT" (cdadr (entget nd2)))
         (eq "PNODE" (strcase (cdr (assoc 2 (entget nd2))))))
   (if (and (setq pl (car (entsel "\nSelect Line Object: ")))
            (member (cdadr (entget pl)) '("LWPOLYLINE" "POLYLINE" "LINE")))
      (if (setq pt (getpoint "\nSelect Point for Block: "))
         (progn
            (and (setq mtxt (car (entsel "\nSelect MTEXT: ")))
               (wcmatch (cdadr (entget mtxt)) "*TEXT"))
            (setq turns (getint "\nSpecify Number of Turns: "))
            (setq ndlst
            (mapcar
               (function
                  (lambda (x)
                  (cdr (assoc 1 (entget (entnext x))))))
               (list nd1 nd2)))
            (setq blk
            (vla-insertblock spc
               (vlax-3D-point (trans pt 1 0)) "NODE.dwg" 1. 1. 1. 0.))
            (foreach att(vlax-safearray->list
                           (vlax-variant-value
                              (vla-getAttributes blk)))
            (cond ((eq "NODE1" (vla-get-TagString att))
                     (vla-put-TextString att (car ndlst)))
                  ((eq "NODE2" (vla-get-TagString att))
                     (vla-put-TextString att (cadr ndlst)))
                  ((eq "LENGTH" (vla-get-TagString att))
                     (vla-put-TextString att
                     (rtos
                        (vla-get-Length
                           (vlax-ename->vla-object pl)))))
                  ((eq "TURNS" (vla-get-TagString att))
                     (if turns
                     (vla-put-TextString att
                        (rtos turns))))
                  ((eq "COIL" (vla-get-TagString att))
                     (vla-put-TextString att
                     (if mtxt
                        (cdr (assoc 1 (entget mtxt))) ""))))))
      (princ "\n<!> No Point Selected <!>"))
      (princ "\n<!> Incorrect LINE Object Selection <!>"))
   (princ "\n<!> Incorrect Selection of NODE 2 <!>"))
(princ "\n<!> Incorrect Selection of NODE 1 <!>"))
(princ "\n<!> NODE Block not Found <!>"))
(princ))

chelsea1307 发表于 2022-7-6 10:25:38

太棒了，谢谢！

页: 1 [2]

乐筑天下's Archiver