求助-帮忙改程序的对齐点
本帖最后由 seamopan 于 2022-10-16 13:08 编辑(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
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 (vlax-safearray->list ma)
pmin (vlax-safearray->list mi)
)
(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) "" (list (car zx) (cadr ys))
(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))
)
)
(princ)
)
以上程序是论坛中借用别个大佬的程序,可以实现多图纸的合并,但合并后的图纸是采用每个图纸的左上角对齐的关系排布的,而且每个图框外围会额外增加一个线框,现在想实现合并后的图纸是以每个图框的左下角对齐,然后去掉每个图框额外增加的线框,请哪位高手指点下程序的更改;:handshake
甜兮兮 发表于 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)
)
(if (> dy cdy)
(setq cdy dy)
)
(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))
)
就后面这几个x y改一改换就变位置了 飞雪神光 发表于 2022-10-16 15:43
去掉包围框 左下到右上排列
感谢大佬啊!能排列按左到右,行的排列从上到下排列吗?如果能手动输入图纸排列的行距功能就更齐全了 去掉包围框 左下到右上排列 seamopan 发表于 2022-10-16 20:28
感谢大佬啊!能排列按左到右,行的排列从上到下排列吗?如果能手动输入图纸排列 ...
没看懂怎么排列 飞雪神光 发表于 2022-10-16 21:00
没看懂怎么排列
就是从左往右排列,分行的话就是自上而下排列,往Y的负方向分行啊 本帖最后由 seamopan 于 2022-10-16 22:13 编辑
飞雪神光 发表于 2022-10-16 21:05
(if (> dy cdy)
(setq cdy dy)
)
谢谢您!在你的提示下我已经改成想要的结果了 飞雪神光 大佬可否改成自动线框偏移10mm那种效果 , 飞雪神光 发表于 2022-10-16 15:43
去掉包围框 左下到右上排列
大佬 有空可否看看怎么改? 你是想保留线框是嘛
页:
[1]
2