批量合并图

364836483 · 发表于 2022-7-13 16:27:00

把多个图批量合并到一个DWG里，求开发，付费。364836483qq

szhorse · 发表于 2022-7-13 21:29:00

试试这个，发扬乐筑天下精神
来自网络，不知道哪位大神的，在此谢过
合并图纸(左对齐或上对齐)

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:eo5uqbq2emo.lsp
下载次数:0 文件大小:2.06 KB 售价:2银币 [记录]
下载权限: 不限以上或 Vip会员 [开通Vip] [签到领银币] [免费赚银币]

尘缘一生 · 发表于 2022-7-16 20:49:00

;;批量目录图纸插入-----------【开始】---------
(defun plins-dwg (/ e_lst ent fn files flis pt pt0 box d h h0 k0 i n str)
  (_undo1)
  (setq e_lst (sysvar '("osmode" "cmdecho" "filedia")))
  (setvar "filedia" 0)
  (setvar "cmdecho" 0)
  (setvar "OSMODE" 0)
  (vla-put-WindowState *ACAD* 2)  ;;CAD窗口最小化
  (setq files (xl-div (sl-choose-files "" "dxf;*.dwg" (getvar "DWGPREFIX")) 10))
  (vla-put-WindowState *ACAD* 1)  ;;CAD窗口最大化
  (setq pt (getpoint "\n 请给出排图基点（左下角）？") k0 0.0)
  (setq str (sl:do1ordo2 "插入形式为" "参照" "图块"))
  (repeat (setq n (length files))
(setq pt0 (polar pt pi2 k0))
(setq flis (nth (setq n (1- n)) files) h0 0.0)
(repeat (setq i (length flis))
   (setq fn (nth (setq i (1- i)) flis))
   (if (= str "参照")
      (command "-XREF" "A" fn pt0 1 1 0)
      (vla-ins-b fn pt0 1 1 1 0)
   )
   (setq ent (entlast) box (ebox4 ent) d (- (car (caddr box)) (car (car box))) h (- (cadr (cadddr box)) (cadr (car box))))
   (if (>= h h0) (setq h0 h))
   (sl_subupd ent 10 pt0)
   (setq pt0 (polar pt0 0 (* d 1.05)))
   (if (= str "图块") (slexplode (entlast)))
)
(setq k0 (+ k0 (* h0 1.05)))
  )
  (command "zoom" "e")
  (mapcar 'eval e_lst)
  (_undo2)
  (princ)
)
链接：https://pan.baidu.com/s/1uNCjpZ6Jb_npa-JTFeS-AA 提取码：50sz

ht1480 · 发表于 2022-7-19 12:46:00

自己用的特简单
可选文件夹，块被分解，不想分解就把“*”去掉，粘贴到原坐标，原坐标重叠的话把插入点改改也行。
我也是抄抄改改大佬的函数和代码
分享是个良性循环

copy


(defun C:xwj ()
(vl-load-com)
  (setq path (GXL-FILE-GETFOLDER))
  (setq file (VL-DIRECTORY-FILES path "*.dwg" 1))
  (foreach dwg file
    (command "insert" (strcat "*" path "" dwg) '(0 0 0) 1 0)
    )
)
;; (gxl-file-GetFolder "选择文件夹:") 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
(defun gxl-file-GetFolder (/ WinShell shFolder path catchit)
  (setq winshell (vlax-create-object "Shell.Application"))
  (setq        shFolder (vlax-invoke-method
                   WinShell 'BrowseForFolder 0 "选取文件夹" 1)
  )
  (setq
    catchit (vl-catch-all-apply
              '(lambda ()
                 (setq shFolder (vlax-get-property shFolder 'self))
                 (setq path (vlax-get-property shFolder 'path))
               )
            )
  )
  (if (vl-catch-all-error-p catchit)
    nil
    path
  )
)