求助拼接图形

south · 发表于 2023-3-17 10:06:03

本帖最后由 south 于 2023-3-17 10:12 编辑

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

start4444 · 发表于 2023-3-17 10:06:04

本帖最后由 start4444 于 2023-3-17 15:05 编辑

(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 · 发表于 2023-3-17 10:32:12

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

lailaifa · 发表于 2023-3-17 12:07:36

C:\Users\Administrator\Desktop

lailaifa · 发表于 2023-3-17 12:09:17

是不是这样

south · 发表于 2023-3-17 13:47:42

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 · 发表于 2023-3-17 13:51:14

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

是不是漏了啥

lailaifa · 发表于 2023-3-17 13:55:33

lailaifa · 发表于 2023-3-17 13:56:36

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

还不这么会玩明经

south · 发表于 2023-3-17 13:59:17

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

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

账号		自动登录	找回密码
密码			注册