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
查看完整版本: 求助-帮忙改程序的对齐点