乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
楼主: chelsea1307

[编程交流] LISP插入两个属性，

[复制链接]
Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 09:56:27 | 显示全部楼层
啊，还有一件事，属性的标签是什么？
回复

使用道具 举报

chelsea1307

57

主题

351

帖子

294

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
285
发表于 2022-7-6 09:59:17 | 显示全部楼层
节点1
节点2
长
线圈
 
现在就试试
节点。图纸
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 10:03:46 | 显示全部楼层
你有2004年版的吗？
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 10:07:31 | 显示全部楼层
可能是这样吗？
 
  2. (defun c:NdUpd  (/ doc spc nd1 nd2 pl mtxt pt ndlst blk)
  3.  (vl-load-com)
  5.  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
  6.        spc (if (zerop (vla-get-activespace doc))
  7.              (if (= (vla-get-mspace doc) :vlax-true)
  8.                (vla-get-modelspace doc)
  9.                (vla-get-paperspace doc))
  10.              (vla-get-modelspace doc)))
  12.  (if (or (tblsearch "BLOCK" "NODE")
  13.          (findfile "NODE.dwg"))
  14.    (if (and (setq nd1 (car (entsel "\nSelect Node 1: ")))
  15.             (eq "INSERT" (cdadr (entget nd1)))
  16.             (eq "PNODE" (cdr (assoc 2 (entget nd1)))))
  17.      (if (and (setq nd2 (car (entsel "\nSelect Node 2: ")))
  18.               (eq "INSERT" (cdadr (entget nd2)))
  19.               (eq "PNODE" (cdr (assoc 2 (entget nd2)))))
  20.        (if (and (setq pl (car (entsel "\nSelect Line Object: ")))
  21.                 (member (cdadr (entget pl)) '("LWPOLYLINE" "POLYLINE" "LINE")))
  22.          (if (and (setq mtxt (car (entsel "\nSelect MTEXT: ")))
  23.                   (wcmatch (cdadr (entget mtxt)) "*TEXT"))
  24.            (if (setq pt (getpoint "\nSelect Point for Block: "))
  25.              (progn
  26.                (setq ndlst
  27.                  (mapcar
  28.                    (function
  29.                      (lambda (x)
  30.                        (cdr (assoc 1 (entget (entnext x))))))
  31.                    (list nd1 nd2)))
  32.                (setq blk
  33.                  (vla-insertblock spc
  34.                    (vlax-3D-point (trans pt 1 0)) "NODE.dwg" 1. 1. 1. 0.))
  35.                (foreach att  (vlax-safearray->list
  36.                                (vlax-variant-value
  37.                                  (vla-getAttributes blk)))
  38.                  (cond ((eq "NODE1" (vla-get-TagString att))
  39.                         (vla-put-TextString att (car ndlst)))
  40.                        ((eq "NODE2" (vla-get-TagString att))
  41.                         (vla-put-TextString att (cadr ndlst)))
  42.                        ((eq "LENGTH" (vla-get-TagString att))
  43.                         (vla-put-TextString att
  44.                           (rtos
  45.                             (vla-get-Length
  46.                               (vlax-ename->vla-object pl)))))
  47.                        ((eq "COIL" (vla-get-TagString att))
  48.                         (vla-put-TextString att
  49.                           (cdr (assoc 1 (entget mtxt))))))))
  50.              (princ "\n<!> No Point Selected <!>"))
  51.            (princ "\n<!> Incorrect MTEXT Selection <!>"))
  52.          (princ "\n<!> Incorrect LINE Object Selection <!>"))
  53.        (princ "\n<!> Incorrect Selection of NODE 2 <!>"))
  54.      (princ "\n<!> Incorrect Selection of NODE 1 <!>"))
  55.    (princ "\n<!> NODE Block not Found <!>"))
  56.  (princ))
回复

使用道具 举报

chelsea1307

57

主题

351

帖子

294

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
285
发表于 2022-7-6 10:07:58 | 显示全部楼层
它适用于那些有线圈和多行文字的，但如果我没有多行文字，它会出错，有没有办法使多行文字选择可选？如果你点击它，它包括它，如果你不它跳过它，并继续？或者别的什么
回复

使用道具 举报

chelsea1307

57

主题

351

帖子

294

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
285
发表于 2022-7-6 10:10:58 | 显示全部楼层
你给我的代码很好用，除了我没有多行文字的情况。我试着把它取出来，给它一个新的方块（一个没有线圈斑点的方块），但它说的论点太少了，有人看到我哪里出错了吗？
  1. (defun c:NdUpd2  (/ doc spc nd1 nd2 pl mtxt pt ndlst blk)
  2.  (vl-load-com)
  3.  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
  4.        spc (if (zerop (vla-get-activespace doc))
  5.              (if (= (vla-get-mspace doc) :vlax-true)
  6.                (vla-get-modelspace doc)
  7.                (vla-get-paperspace doc))
  8.              (vla-get-modelspace doc)))
  9.  (if (or (tblsearch "BLOCK" "NODE2")
  10.          (findfile "Node2.dwg"))
  11.    (if (and (setq nd1 (car (entsel "\nSelect Node 1: ")))
  12.             (eq "INSERT" (cdadr (entget nd1)))
  13.             (eq "PNODE" (cdr (assoc 2 (entget nd1)))))
  14.      (if (and (setq nd2 (car (entsel "\nSelect Node 2: ")))
  15.               (eq "INSERT" (cdadr (entget nd2)))
  16.               (eq "PNODE" (cdr (assoc 2 (entget nd2)))))
  17.        (if (and (setq pl (car (entsel "\nSelect Line Object: ")))
  18.                 (member (cdadr (entget pl)) '("LWPOLYLINE" "POLYLINE" "LINE")))
  19.            (if (setq pt (getpoint "\nSelect Point for Block: "))
  20.              (progn
  21.                (setq ndlst
  22.                  (mapcar
  23.                    (function
  24.                      (lambda (x)
  25.                        (cdr (assoc 1 (entget (entnext x))))))
  26.                    (list nd1 nd2)))
  27.                (setq blk
  28.                  (vla-insertblock spc
  29.                    (vlax-3D-point (trans pt 1 0)) "Node2.dwg" 1. 1. 1. 0.))
  30.                (foreach att  (vlax-safearray->list
  31.                                (vlax-variant-value
  32.                                  (vla-getAttributes blk)))
  33.                  (cond ((eq "NODE1" (vla-get-TagString att))
  34.                         (vla-put-TextString att (car ndlst)))
  35.                        ((eq "NODE2" (vla-get-TagString att))
  36.                         (vla-put-TextString att (cadr ndlst)))
  37.                        ((eq "LENGTH" (vla-get-TagString att))
  38.                         (vla-put-TextString att
  39.                           (rtos
  40.                             (vla-get-Length))))))))
  41.              (princ "\n<!> No Point Selected <!>"))
  42.          (princ "\n<!> Incorrect LINE Object Selection <!>"))
  43.        (princ "\n<!> Incorrect Selection of NODE 2 <!>"))
  44.      (princ "\n<!> Incorrect Selection of NODE 1 <!>"))
  45.    (princ "\n<!> NODE Block not Found <!>"))
  46.  (princ))
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 10:16:29 | 显示全部楼层
这应该提供无多行文字的选项。。。
 
  2. (defun c:NdUpd  (/ doc spc nd1 nd2 pl mtxt pt ndlst blk)
  3.  (vl-load-com)
  5.  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
  6.        spc (if (zerop (vla-get-activespace doc))
  7.              (if (= (vla-get-mspace doc) :vlax-true)
  8.                (vla-get-modelspace doc)
  9.                (vla-get-paperspace doc))
  10.              (vla-get-modelspace doc)))
  12.  (if (or (tblsearch "BLOCK" "NODE")
  13.          (findfile "NODE.dwg"))
  14.    (if (and (setq nd1 (car (entsel "\nSelect Node 1: ")))
  15.             (eq "INSERT" (cdadr (entget nd1)))
  16.             (eq "PNODE" (strcase (cdr (assoc 2 (entget nd1))))))
  17.      (if (and (setq nd2 (car (entsel "\nSelect Node 2: ")))
  18.               (eq "INSERT" (cdadr (entget nd2)))
  19.               (eq "PNODE" (strcase (cdr (assoc 2 (entget nd2))))))
  20.        (if (and (setq pl (car (entsel "\nSelect Line Object: ")))
  21.                 (member (cdadr (entget pl)) '("LWPOLYLINE" "POLYLINE" "LINE")))
  22.            (if (setq pt (getpoint "\nSelect Point for Block: "))
  23.              (progn
  24.                (and (setq mtxt (car (entsel "\nSelect MTEXT: ")))
  25.                     (wcmatch (cdadr (entget mtxt)) "*TEXT"))
  26.                (setq ndlst
  27.                  (mapcar
  28.                    (function
  29.                      (lambda (x)
  30.                        (cdr (assoc 1 (entget (entnext x))))))
  31.                    (list nd1 nd2)))
  32.                (setq blk
  33.                  (vla-insertblock spc
  34.                    (vlax-3D-point (trans pt 1 0)) "NODE.dwg" 1. 1. 1. 0.))
  35.                (foreach att  (vlax-safearray->list
  36.                                (vlax-variant-value
  37.                                  (vla-getAttributes blk)))
  38.                  (cond ((eq "NODE1" (vla-get-TagString att))
  39.                         (vla-put-TextString att (car ndlst)))
  40.                        ((eq "NODE2" (vla-get-TagString att))
  41.                         (vla-put-TextString att (cadr ndlst)))
  42.                        ((eq "LENGTH" (vla-get-TagString att))
  43.                         (vla-put-TextString att
  44.                           (rtos
  45.                             (vla-get-Length
  46.                               (vlax-ename->vla-object pl)))))
  47.                        ((eq "COIL" (vla-get-TagString att))
  48.                         (vla-put-TextString att
  49.                           (if mtxt
  50.                             (cdr (assoc 1 (entget mtxt))) ""))))))
  51.            (princ "\n<!> No Point Selected <!>"))
  52.          (princ "\n<!> Incorrect LINE Object Selection <!>"))
  53.        (princ "\n<!> Incorrect Selection of NODE 2 <!>"))
  54.      (princ "\n<!> Incorrect Selection of NODE 1 <!>"))
  55.    (princ "\n<!> NODE Block not Found <!>"))
  56.  (princ))
回复

使用道具 举报

chelsea1307

57

主题

351

帖子

294

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
285
发表于 2022-7-6 10:18:42 | 显示全部楼层
这很有效。是否很难添加一个点来请求轮次并从0开始进行数字插入？我可以将其添加到带标记的块中
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 10:23:21 | 显示全部楼层
不太难
 
  2. (defun c:NdUpd  (/ doc spc nd1 nd2 pl mtxt pt ndlst blk turns)
  3.  (vl-load-com)
  5.  (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
  6.        spc (if (zerop (vla-get-activespace doc))
  7.              (if (= (vla-get-mspace doc) :vlax-true)
  8.                (vla-get-modelspace doc)
  9.                (vla-get-paperspace doc))
  10.              (vla-get-modelspace doc)))
  12.  (if (or (tblsearch "BLOCK" "NODE")
  13.          (findfile "NODE.dwg"))
  14.    (if (and (setq nd1 (car (entsel "\nSelect Node 1: ")))
  15.             (eq "INSERT" (cdadr (entget nd1)))
  16.             (eq "PNODE" (strcase (cdr (assoc 2 (entget nd1))))))
  17.      (if (and (setq nd2 (car (entsel "\nSelect Node 2: ")))
  18.               (eq "INSERT" (cdadr (entget nd2)))
  19.               (eq "PNODE" (strcase (cdr (assoc 2 (entget nd2))))))
  20.        (if (and (setq pl (car (entsel "\nSelect Line Object: ")))
  21.                 (member (cdadr (entget pl)) '("LWPOLYLINE" "POLYLINE" "LINE")))
  22.            (if (setq pt (getpoint "\nSelect Point for Block: "))
  23.              (progn
  24.                (and (setq mtxt (car (entsel "\nSelect MTEXT: ")))
  25.                     (wcmatch (cdadr (entget mtxt)) "*TEXT"))
  26.                (setq turns (getint "\nSpecify Number of Turns: "))
  27.                (setq ndlst
  28.                  (mapcar
  29.                    (function
  30.                      (lambda (x)
  31.                        (cdr (assoc 1 (entget (entnext x))))))
  32.                    (list nd1 nd2)))
  33.                (setq blk
  34.                  (vla-insertblock spc
  35.                    (vlax-3D-point (trans pt 1 0)) "NODE.dwg" 1. 1. 1. 0.))
  36.                (foreach att  (vlax-safearray->list
  37.                                (vlax-variant-value
  38.                                  (vla-getAttributes blk)))
  39.                  (cond ((eq "NODE1" (vla-get-TagString att))
  40.                         (vla-put-TextString att (car ndlst)))
  41.                        ((eq "NODE2" (vla-get-TagString att))
  42.                         (vla-put-TextString att (cadr ndlst)))
  43.                        ((eq "LENGTH" (vla-get-TagString att))
  44.                         (vla-put-TextString att
  45.                           (rtos
  46.                             (vla-get-Length
  47.                               (vlax-ename->vla-object pl)))))
  48.                        ((eq "TURNS" (vla-get-TagString att))
  49.                         (if turns
  50.                           (vla-put-TextString att
  51.                             (rtos turns))))
  52.                        ((eq "COIL" (vla-get-TagString att))
  53.                         (vla-put-TextString att
  54.                           (if mtxt
  55.                             (cdr (assoc 1 (entget mtxt))) ""))))))
  56.            (princ "\n<!> No Point Selected <!>"))
  57.          (princ "\n<!> Incorrect LINE Object Selection <!>"))
  58.        (princ "\n<!> Incorrect Selection of NODE 2 <!>"))
  59.      (princ "\n<!> Incorrect Selection of NODE 1 <!>"))
  60.    (princ "\n<!> NODE Block not Found <!>"))
  61.  (princ))
回复

使用道具 举报

chelsea1307

57

主题

351

帖子

294

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
285
发表于 2022-7-6 10:25:38 | 显示全部楼层
太棒了，谢谢！
回复

使用道具 举报

12
返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-7 02:50 , Processed in 0.361957 second(s), 70 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表