你是想保留线框是嘛
是的 能否改个线框自动偏移10MM的样子 甜兮兮 发表于 2022-10-22 20:41
是的 能否改个线框自动偏移10MM的样子
(defun c:hbtz (/ tzml filelst i x y pmax pmin zx ys dx dy cdy dwg fn fd)
(vl-load-com)
(defun browseforfolder (msg / shfolder path catchit)
(setq shfolder (vlax-invoke-method (vlax-create-object "Shell.Application")
'browseforfolder
(vlax-get-property
(vlax-get-acad-object)
'hwnd
) msg 1
)
catchit (vl-catch-all-apply '(lambda ()
(setq shfolder
(vlax-get-property shfolder
'self
)
path
(vlax-get-property shfolder
'path
)
)
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)
(setq tzml (browseforfolder "选择文件路径" ))
(if (/= (substr tzml (strlen tzml)) "\\")
(setq tzml (strcat tzml "\\"))
)
(setq filelst (vl-directory-files tzml "*.dwg" 1))
(setq filelst (acad_strlsort filelst)
i -1
x 0
y 0
cdx 0
cdy 0
)
(setq fn (getint " \n [每行文件数量] <1>: " ))
(if (not fn)
(setq fn 1)
)
(setq fd (getreal " \n [文件间距] <100>: "))
(if (not fd)
(setq fd 100)
)
(setvar "osmode" 0)
(setvar "attreq" 0)
(setvar "cmdecho" 0)
(command "ucs" "")
(while (setq dwg (nth (setq i (1+ i))
filelst
)
)
(prompt (strcat "\n" dwg))
(command "insert" (strcat tzml dwg) (list 0 0) "" "" "")
(vla-getboundingbox (vlax-ename->vla-object (entlast)) 'mi 'ma)
(setq
pmax (polar (polar (vlax-safearray->list ma) 0 100) (* pi 0.5) 100)
pmin (polar (polar (vlax-safearray->list mi) pi 100) (* pi 1.5) 100)
)
(setq
zx (list (car pmin) (cadr pmin))
ys (list (car pmax) (cadr pmax))
)
(setq dwg (entlast))
(command "rectangle" pmin pmax)
(command "change" (entlast) "" "p" "C" "1" "")
(command "move" dwg (entlast) "" zx (list x y))
(setq
dy (- (cadr ys) (cadr zx))
dx (- (car ys) (car zx))
)
(if (> dy cdy)
(setq cdy dy)
)
(if (= (rem (1+ i) fn) 0)
(setq
x 0
y (+ y cdy fd)
cdy 0
)
(setq x (+ x dx fd))
)
;(if (> dx cdx)
; (setq cdx dx)
;)
;(if (= (rem (1+ i) fn) 0)
; (setq
; y 0
; x (+ x cdx 2300);行间距
; cdx 0
; )
; (setq y (- y dy fd))
;)
)
(princ)
)
页:
1
[2]