社区 › Auto Lisp › LISP用于将图形移动到0，

K Baden 发表于 2022-7-5 16:07:29

LISP用于将图形移动到0，

如果有办法消除用户干预，那将是理想的。作为需要移动的中心点的对象始终是同一层“塔”上唯一的三角形或圆。
有没有办法让它自动抓取特定层上的圆心和/或三角形的几何中心，然后从所有层中选择所有对象，然后将该中心点作为基点移动到0,0，所有这些都在命令的关键点处？
 
 
你们帮了我很多忙。提前感谢您的建议！

Commandobill 发表于 2022-7-5 16:15:18

如果这是该层上唯一的对象，那么它应该非常简单。你能用LISP写吗？或者你在找人写吗？
 
首先，我将使用李-麦克的多边形质心来获得塔的中心。然后只需使用ssget选择所有项目和vla移动。
 
应该很简单。

ronjonp 发表于 2022-7-5 16:18:25

(defun c:moveto0 (/ p s s2)
(if (and (setq s (ssget "_X"
                  '((-4 . "<OR")
                  (0 . "circle")
                  (-4 . "<AND")
                  (0 . "lwpolyline")
                  (90 . 3)
                  (-4 . "AND>")
                  (-4 . "OR>")
                  (8 . "tower")
                   )
           )
   )
   (setq s2 (ssget "_X" (list (cons 410 (getvar 'ctab)))))
   )
   (progn
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
(progn (setq p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget e))))
       (setq p
                (append (mapcar '(lambda (x) (/ x (length p))) (apply 'mapcar (cons '+ p))) '(0.0))
       )
)
(setq p (cdr (assoc 10 (entget e))))
)
;; Does not check if the object is on a locked layer...
(vlax-invoke (vlax-ename->vla-object e) 'move p '(0. 0. 0.))
(ssdel e s2)
   )
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2)))
;; Does not check if the object is on a locked layer...
(vlax-invoke (vlax-ename->vla-object e) 'move p '(0. 0. 0.))
   )
   )
)
(princ)
)
(vl-load-com)

K Baden 发表于 2022-7-5 16:23:26

这对于移动塔来说效果很好！！在移动之前，是否需要在图形上进行全选？现在，这只移动了那个物体，这很可爱，但我肯定需要整个图形一起移动。
 
非常感谢！！！

Lee Mac 发表于 2022-7-5 16:27:43

罗恩对我来说太快了，但我还是会发我的：
(defun c:twrm ( / ent len lst sel )
   (if (setq sel
         (ssget "_X"
            '(
                   (008 . "TOWER")
                   (410 . "Model")
                   (-04 . "<OR")
                     (000 . "CIRCLE")
                     (-04 . "<AND")
                           (000 . "LWPOLYLINE")
                           (090 . 3)
                           (-04 . "&=")
                           (070 . 1)
                     (-04 . "AND>")
                   (-04 . "OR>")
               )
         )
       )
       (progn
         (setq ent (ssname sel 0)
               lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget ent)))
               len (length lst)
         )
         (command "_.move"
               (ssget "_X" '((410 . "Model"))) ""
               "_non"(trans (mapcar '/ (apply 'mapcar (cons '+ lst)) (list len len)) ent 1)
               "_non" '(0.0 0.0)
         )
       )
       (princ "\nTower object not found.")
   )
   (princ)
)

ronjonp 发表于 2022-7-5 16:35:20

代码已更新。

K Baden 发表于 2022-7-5 16:42:16

这非常有效。非常感谢你们俩！！！

K Baden 发表于 2022-7-5 16:45:13

(defun c:twrm ( / ent len lst sel )
   (if (setq sel
         (ssget "_X"
            '(
                   (008 . "TOWER")
                   (410 . "Model")
                   (-04 . "<OR")
                     (000 . "CIRCLE")
                     (-04 . "<AND")
                           (000 . "LWPOLYLINE")
                           (090 . 3)
                           (-04 . "&=")
                           (070 . 1)
                     (-04 . "AND>")
                   (-04 . "OR>")
               )
         )
       )
       (progn
         (setq ent (ssname sel 0)
               lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget ent)))
               len (length lst)
         )
         (command "_.move"
               (ssget "_X" '((410 . "Model"))) ""
               "_non"(trans (mapcar '/ (apply 'mapcar (cons '+ lst)) (list len len)) ent 1)
               "_non" '(0.0 0.0)
         )
       )
       (princ "\nTower object not found.")
   )
   (princ)
)
 
添加罕见但偶尔出现的方形塔楼只是添加另一条线吗？我猜突出显示的线会寻找带有3个点的线？它会像重复这个并使其成为4一样简单吗？

ronjonp 发表于 2022-7-5 16:48:43

如果分层是实心的，则可能需要进行顶点数检查。
 
您也可以这样做来检查顶点少于5个的LWD多段线：
（ssget“_X”'（（008“*”）（410。“型号”）（-04。“

K Baden 发表于 2022-7-5 16:54:01

打得好！我甚至没想过。这适用于我测试过的各种场景。谢谢大家！！

查看完整版本: LISP用于将图形移动到0，