tancked 发表于 2022-7-5 23:52:24

LISP帮助：将3dpoly移动到新位置

我在编写LISP例程方面经验很少，如果有任何帮助，我将不胜感激。
我需要一个LISP来搜索最接近3Dpoly的文本或多行文字字符串，并用该字符串创建一个层；然后将3Dpoly移动到该新层。
 
我发现了一个类似的lisp，但它只适用于直线和多边形，而不适用于三维多边形。
 

(defun c:lin2lay(/
          filter_set
          l2l_inspt
          l2l_linset
          l2l_pt
          l2l_set
          l2l_tol
          l2l_txtset
          )
(vl-load-com);;added
(defun filter_ent(ent_type sset)
   (setq filter_set '())
   (foreach
      x
       ent_type
   (setq filter_set
      (append (mapcar '(lambda (y)
               (cdr (assoc -1 y))
               ) ;_ end_lambda
                (vl-remove-if-not
                  '(lambda    (y)
               (= (cdr (assoc 0 y)) x)
               ) ;_ end_lambda
                  (mapcar 'entget
                      (vl-remove-if
                  'listp
                  (mapcar 'cadr
                        (ssnamex sset)
                        ) ;_ end_mapcar
                  ) ;_ end_vl-remove-if
                      ) ;_ end_mapcar
                  ) ;_ end_vl-remove-if-not
                ) ;_ end_mapcar
            filter_set
            ) ;_ end_append
       ) ;_ end_setq
   ) ;_ end_foreach
   ) ;_ end_defun

(if (and (setq l2l_set (ssget '((0 . "LINE,LWPOLYLINE,TEXT,MTEXT"))))
      (setq l2l_tol (getreal "\n>>>...Enter gap tolerance..>>>: "))
      (setq l2l_linset (filter_ent '("LINE" "LWPOLYLINE") l2l_set))
      (setq l2l_txtset
         (filter_ent
         '("TEXT" "MTEXT")
         (car (mapcar '(lambda (x) (ssdel x l2l_set)) l2l_linset)))))
   (progn
   (acet-ui-progress "PROCESSING..." (length l2l_linset))
   (mapcar
   '(lambda (y)
    (setq l2l_pt nil)
    (mapcar
      '(lambda (z)
         (setq l2l_inspt (cdr (assoc 10 (entget z))))
         (if (< (distance
            l2l_inspt
            (vlax-curve-getclosestpointto y l2l_inspt))
            l2l_tol)
       (entmod
         (subst
         (cons 8 (cdr (assoc 1 (entget z))))
         (assoc 8 (entget y))
         (entget y))
         )
       )
         )
      l2l_txtset)
    (acet-ui-progress -1)
    )
   l2l_linset)(acet-ui-progress )))
(princ))

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

MSasu 发表于 2022-7-6 00:16:21

Tancked，请编辑您的帖子，再次添加代码，这次使用所需的代码标签。人们会发现调试代码非常困难，因为
当前格式。

tancked 发表于 2022-7-6 00:24:43

MSasu，我为这篇糟糕的帖子道歉。我已经更新了我的帖子，非常感谢您的帮助。

MSasu 发表于 2022-7-6 00:33:59

不需要道歉！感谢您修复格式。
 
关于您正在寻找的修改，只需将实体类型添加到过滤器列表：
...
(if (and (setq l2l_set (ssget '((0 . "*LINE,TEXT,MTEXT"))))
      (setq l2l_tol (getreal "\n>>>...Enter gap tolerance..>>>: "))
      (setq l2l_linset (filter_ent '("LINE" "LWPOLYLINE" "POLYLINE") l2l_set))
...
一个观察结果是，您的代码将使用第一个遇到的标签，而不是最近的标签。

tancked 发表于 2022-7-6 00:50:18

非常感谢这一点。

MSasu 发表于 2022-7-6 01:00:27

听起来不错。不客气！
页: [1]
查看完整版本: LISP帮助：将3dpoly移动到新位置