乐筑天下

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

[编程交流] LISP帮助:将3dpoly移动到新位置

[复制链接]

1

主题

3

帖子

2

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-5 23:52:24 | 显示全部楼层 |阅读模式
我在编写LISP例程方面经验很少,如果有任何帮助,我将不胜感激。
我需要一个LISP来搜索最接近3Dpoly的文本或多行文字字符串,并用该字符串创建一个层;然后将3Dpoly移动到该新层。
 
我发现了一个类似的lisp,但它只适用于直线和多边形,而不适用于三维多边形。
 
  1. (defun c:lin2lay  (/
  2.           filter_set
  3.           l2l_inspt
  4.           l2l_linset
  5.           l2l_pt
  6.           l2l_set
  7.           l2l_tol
  8.           l2l_txtset
  9.           )
  10. (vl-load-com);;added
  11. (defun filter_ent  (ent_type sset)
  12.    (setq filter_set '())
  13.    (foreach
  14.       x
  15.        ent_type
  16.      (setq filter_set
  17.         (append (mapcar '(lambda (y)
  18.                (cdr (assoc -1 y))
  19.                ) ;_ end_lambda
  20.                 (vl-remove-if-not
  21.                   '(lambda    (y)
  22.                  (= (cdr (assoc 0 y)) x)
  23.                  ) ;_ end_lambda
  24.                   (mapcar 'entget
  25.                       (vl-remove-if
  26.                     'listp
  27.                     (mapcar 'cadr
  28.                         (ssnamex sset)
  29.                         ) ;_ end_mapcar
  30.                     ) ;_ end_vl-remove-if
  31.                       ) ;_ end_mapcar
  32.                   ) ;_ end_vl-remove-if-not
  33.                 ) ;_ end_mapcar
  34.             filter_set
  35.             ) ;_ end_append
  36.        ) ;_ end_setq
  37.      ) ;_ end_foreach
  38.    ) ;_ end_defun
  39. (if (and (setq l2l_set (ssget '((0 . "LINE,LWPOLYLINE,TEXT,MTEXT"))))
  40.       (setq l2l_tol (getreal "\n>>>...Enter gap tolerance..>>>: "))
  41.       (setq l2l_linset (filter_ent '("LINE" "LWPOLYLINE") l2l_set))
  42.       (setq l2l_txtset
  43.          (filter_ent
  44.            '("TEXT" "MTEXT")
  45.            (car (mapcar '(lambda (x) (ssdel x l2l_set)) l2l_linset)))))
  46.    (progn
  47.    (acet-ui-progress "PROCESSING..." (length l2l_linset))
  48.    (mapcar
  49.      '(lambda (y)
  50.     (setq l2l_pt nil)
  51.     (mapcar
  52.       '(lambda (z)
  53.          (setq l2l_inspt (cdr (assoc 10 (entget z))))
  54.          (if (< (distance
  55.               l2l_inspt
  56.               (vlax-curve-getclosestpointto y l2l_inspt))
  57.             l2l_tol)
  58.        (entmod
  59.          (subst
  60.            (cons 8 (cdr (assoc 1 (entget z))))
  61.            (assoc 8 (entget y))
  62.            (entget y))
  63.          )
  64.        )
  65.          )
  66.       l2l_txtset)
  67.     (acet-ui-progress -1)
  68.     )
  69.      l2l_linset)(acet-ui-progress )))
  70. (princ))

 
源代码http://forums.cadalyst.com/showthread.php?t=6313作者:wizman
 
任何帮助都将不胜感激
回复

使用道具 举报

35

主题

2471

帖子

2447

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
174
发表于 2022-7-6 00:16:21 | 显示全部楼层
Tancked,请编辑您的帖子,再次添加代码,这次使用所需的代码标签。人们会发现调试代码非常困难,因为
当前格式。
回复

使用道具 举报

1

主题

3

帖子

2

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-6 00:24:43 | 显示全部楼层
MSasu,我为这篇糟糕的帖子道歉。我已经更新了我的帖子,非常感谢您的帮助。
回复

使用道具 举报

35

主题

2471

帖子

2447

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
174
发表于 2022-7-6 00:33:59 | 显示全部楼层
不需要道歉!感谢您修复格式。
 
关于您正在寻找的修改,只需将实体类型添加到过滤器列表:
  1. ...
  2. (if (and (setq l2l_set (ssget '((0 . "[color=magenta]*[/color]LINE,TEXT,MTEXT"))))
  3.         (setq l2l_tol (getreal "\n>>>...Enter gap tolerance..>>>: "))
  4.         (setq l2l_linset (filter_ent '("LINE" "LWPOLYLINE" [color=magenta]"POLYLINE"[/color]) l2l_set))
  5. ...

一个观察结果是,您的代码将使用第一个遇到的标签,而不是最近的标签。
回复

使用道具 举报

1

主题

3

帖子

2

银币

初来乍到

Rank: 1

铜币
5
发表于 2022-7-6 00:50:18 | 显示全部楼层
非常感谢这一点。
回复

使用道具 举报

35

主题

2471

帖子

2447

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
174
发表于 2022-7-6 01:00:27 | 显示全部楼层
听起来不错。不客气!
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-10 21:08 , Processed in 0.600568 second(s), 64 queries .

© 2020-2025 乐筑天下

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