偏移多个块

qald · 发表于 2022-7-5 23:45:41

好的，让我先解释一下我的情况。我目前正在处理2000多个模块，根据终端消费者的需要，将它们以不同的组合进行组装。组装后，我需要在最终产品周围添加一个6英尺的边框。目前，我一直在这样做，就是在我拥有的任何块的粗糙顶点周围使用“圆”命令，然后从一个切线到另一个切线绘制一条线，然后修剪掉多余的圆。完成后，我把它展平到z=0，这样我就有了一个6英尺的边界。效果很好，但这是一个缓慢而乏味的过程。

现在我的问题是，有没有一种方法（lisp或其他方法）来获取所有选定的块并执行相同的操作，或者甚至只是生成圆，因为这会缩短一些时间？

我会说我几乎没有lisp的知识，所以如果这是解决方案，在启动和运行中有任何帮助都将不胜感激。

万分感谢！

jdiala · 发表于 2022-7-6 00:03:56

copy

(defun C:test (/ ss p pr d o)
(if 
 (setq ss (ssget)
       p  (LM:ssboundingbox ss) 
       o  72) ;;change offset value  
 (entmake 
   (list 
     '(0 . "LWPOLYLINE")
     '(100 . "AcDbEntity")
     '(67 . 0)
     (cons 410 (getvar 'ctab))
     '(100 . "AcDbPolyline")
     '(90 . 4)
     '(70 . 1)
     (cons 10 (setq pr (polar (polar (car p) pi o) (* pi 1.5) o)))
     (cons 10 (setq pr (polar pr 0 (setq d (+ (- (caadr p) (caar p)) (* o 2))))))
     (cons 10 (setq pr (polar pr (/ pi 2.) (+ (- (cadadr p) (cadar p)) (* 2 o)))))
     (cons 10 (polar pr pi d ))
     '(210 0.0 0.0 1.0)
   )
 )
)
(princ)
)
(defun LM:ssboundingbox ( s / a b i m n o )
;; Selection Set Bounding Box  -  Lee Mac
   (repeat (setq i (sslength s))
       (if
           (and
               (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
               (vlax-method-applicable-p o 'getboundingbox)
               (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
           )
           (setq m (cons (vlax-safearray->list a) m)
                 n (cons (vlax-safearray->list b) n)
           )
       )
   )
   (if (and m n)
       (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
   )
)