求助-帮忙改程序的对齐点

seamopan 发表于 2022-10-16 12:55:14

本帖最后由 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-23 00:23:48

甜兮兮发表于 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)
)

飞雪神光 发表于 2022-10-16 21:05:48

(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改一改换就变位置了

seamopan 发表于 2022-10-16 20:28:29

飞雪神光发表于 2022-10-16 15:43
去掉包围框左下到右上排列

感谢大佬啊！能排列按左到右，行的排列从上到下排列吗？如果能手动输入图纸排列的行距功能就更齐全了

飞雪神光 发表于 2022-10-16 15:43:25

去掉包围框左下到右上排列

飞雪神光 发表于 2022-10-16 21:00:31

seamopan 发表于 2022-10-16 20:28
感谢大佬啊！能排列按左到右，行的排列从上到下排列吗？如果能手动输入图纸排列 ...

没看懂怎么排列

seamopan 发表于 2022-10-16 21:41:58

飞雪神光发表于 2022-10-16 21:00
没看懂怎么排列

就是从左往右排列，分行的话就是自上而下排列，往Y的负方向分行啊

seamopan 发表于 2022-10-16 21:46:05

本帖最后由 seamopan 于 2022-10-16 22:13 编辑

飞雪神光发表于 2022-10-16 21:05
(if (> dy cdy)
(setq cdy dy)
)
谢谢您！在你的提示下我已经改成想要的结果了

甜兮兮 发表于 2022-10-21 11:13:46

飞雪神光大佬可否改成自动线框偏移10mm那种效果，

甜兮兮 发表于 2022-10-22 00:09:22

飞雪神光发表于 2022-10-16 15:43
去掉包围框左下到右上排列

大佬有空可否看看怎么改？

飞雪神光 发表于 2022-10-22 14:11:49

你是想保留线框是嘛

页: [1] 2

明经CAD社区's Archiver

求助-帮忙改程序的对齐点