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

甜兮兮

飞雪神光 发表于 2022-10-22 14:11
你是想保留线框是嘛

是的   能否改个线框自动偏移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)
)