LISP用于将图形移动到0，

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

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

你们帮了我很多忙。提前感谢您的建议！

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

如果这是该层上唯一的对象，那么它应该非常简单。你能用LISP写吗？或者你在找人写吗？

首先，我将使用李-麦克的多边形质心来获得塔的中心。然后只需使用ssget选择所有项目和vla移动。

应该很简单。

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

copy

(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

罗恩对我来说太快了，但我还是会发我的：

copy

(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

copy

(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)
)