求助拼接图形

south

有没有前辈有写过拼接图形的lsp，如图及附件

start4444

• (defun c:tt5 (/ d0 d1 d2 dx enbox ent1 ent2 h p0a p0b p1a p1b p2a p2b ss ss1 ss2)
•   (defun enbox (ename / ll ur)
•   (vla-getboundingbox (vlax-ename->vla-object ename) 'll 'ur)
•   (mapcar 'vlax-safearray->list (list ll ur))
• )
•   (setq ss1 (ssget) ss2 (ssget))
• (command "PEDITACCEPT" "1") (command ".pedit" "m" ss1 "" "j" "0" "") (setq ent1 (entlast))  
• (command ".pedit" "m" ss2 "" "j" "0" "" "PEDITACCEPT" "0") (setq ent2 (entlast))  
• (setq dx (getdist "\n输入裁减尺寸："))
• (setq p1a (car (enbox ent1)) p1b (cadr (enbox ent1))  p2a (car (enbox ent2)) p2b (cadr (enbox ent2)) p0a (list (caar (enbox ent1)) (cadadr (enbox ent1))))
• (setq d1 (- (car p1b) (car p1a)) d2 (- (car p2b) (car p2a)) h (- (cadr p2b) (cadr p2a)) d0 (- (+ d1 d2) dx) p0b (polar (polar p0a (* 0 pi) d0) (* 1.5 pi) h))  
• (command "RECTANG" "non" p0a "non" p0b)  
• (entmake (list '(0 . "LINE") (cons 10 (polar p0a 0 (* 0.5 d0))) (cons 11 (polar p0b pi (* 0.5 d0))) (cons 62 1)))  
•   (princ)
• )
  

lailaifa

榔头钣金工具箱有这个功能

lailaifa

C:\Users\Administrator\Desktop

lailaifa

是不是这样

south

start4444 发表于 2023-3-17 11:38
(defun c:tt5 (/ d0 d1 d2 dx enbox ent1 ent2 h p0a p0b p1a p1b p2a p2b ss)
        (defun enbox (ename / ll ...

能不能类似于平移过去，保留A不动，只移动B的图元向A的邻近线（等于平移过去的多了需要减掉的值），如果全部框选的不是多断线会全部叠一起了

south

lailaifa 发表于 2023-3-17 12:09
是不是这样

是不是漏了啥

lailaifa

lailaifa

south 发表于 2023-3-17 13:51
是不是漏了啥

还不这么会玩明经

south

lailaifa 发表于 2023-3-17 13:56
还不这么会玩明经

大概是这样，想要个单独的功能