怎么把目录下的DWG批量插入一张图里面并加外框(想不明白怎么加框)

kry · 发表于 2014-12-26 11:24:37

怎么把目录下的DWG批量插入一张图里面并加外框，想不明白怎么加框，有源码最好，没有的话有思路也行，谢谢!

xyp1964 · 发表于 2014-12-26 13:31:49

kry · 发表于 2014-12-26 14:11:49

xyp1964 发表于 2014-12-26 13:31

院长太不厚道了，收了币回复等于没回复，不愿意放源码至少把思路写明白吧!

xyp1964 · 发表于 2014-12-26 14:28:06

待插入文件列表；确定起点；逐个插入；求图块的左下和右上角点；加外框；右下角点作为新的插入点……

x_s_s_1 · 发表于 2014-12-26 14:45:32

本帖最后由 x_s_s_1 于 2014-12-26 14:55 编辑

很烂的代码，自己改改基本思路是一样的，未测试

;; ! ***************************************************************************
;; ! xd_GetObjectBoundingBox
;; ! ***************************************************************************
;; ! 功能 : 返回实体包围盒的对角点.
;; ! 参数 : 'ename' - Any Drawing Object
;; ! 返回值 : 'Lst' - is a list of LL and UR
;; ! 说明 : 适用 AutoCAD 2000+
;; ! e-mail : eachy@xdcad.net
;; ! Web : www.xdcad.net
;; ! ****************************************************************************
(defun xd_GetObjectBoundingBox (ename / ll ur)
(vla-GetBoundingBox (vlax-ename->vla-object ename) 'll 'ur)
(list
(reverse (cdr (reverse (vlax-safearray->list ll))))
(reverse (cdr (reverse (vlax-safearray->list ur))))
) ;_ 结束list
) ;_ 结束defun
;; ! ***************************************************************************
;; ! lstf(lst files)
;; ! ***************************************************************************
;; ! 功能 : 从表中提取特殊字段子表.
;; ! 参数 : (lst lst需判断的字符串如"CHKPM*" files 表)
;; ! 返回值 : 'Lstt' - 子表
;; ! 说明 : 适用 AutoCAD 2000+
;; ! e-mail : x_s_s_1@163.com
;; ! ****************************************************************************
(defun lstf (lst files / i n)
(setq i 0)
(setq n (length files))
(setq lstt nil)
(while (< i n)
(if (wcmatch (nth i files) lst)
(setq lstt (cons (nth i files) lstt))
t
) ;end if
(setq i (1+ i))
) ;end while
(setq lstt lstt)
) ;end defun
;;;=============================================
;;; 通用函数检查是否存在图层，如无创建之
;;;参数：l_l------线型(字符串)
;;; l_c------颜色(整型)
;;; l_s------图层状态(整型)
;;; l_n------图层名(字符串)
(defun ly_mak (l_l l_c l_s l_n /)
(if (= (tblobjname "LAYER" l_n) nil)
(progn
(entmake (list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 6 l_l)
(cons 62 l_c)
(cons 70 l_s)
(cons 2 l_n)
) ;_ 结束list
) ;_ 结束entmake
) ;_ 结束progn
) ;_ 结束if
) ;_ 结束defun
;;;批量插入子程序
(defun jss_insert (pt file files scale)
(setq x (car pt)
y (cadr pt)
) ;_ 结束setq
(setq max-xpolar 0)
(foreach name files
(progn
(command "-insert"
(strcat file "\" name)
pt
scale
scale
"0"
) ;_ 结束command
(SETQ PTLST (xd_GetObjectBoundingBox (entlast)))
(setq obj1 (entlast))
(setq pt1 (polar (list (car (car PTLST)) (cadr (car PTLST)))
(* pi 1.25)
1000
) ;_ 结束polar
) ;_ 结束setq
(setq pt2 (polar (list (car (cadr PTLST)) (cadr (cadr PTLST)))
(/ pi 4)
1000
) ;_ 结束polar
) ;_ 结束setq
(command "RECTANGLE" pt1 pt2)
(setq obj2 (entlast))
(entmake (list
(cons 0 "TEXT")
(cons 1 name)
(cons 40 600.0)
(cons 41 0.7)
(cons 10 (polar pt1 (/ pi 4) 1500))
(cons 50 (/ pi 2))
(cons 8 "吟一手好诗")
(cons 7 "hz")
) ;_ 结束list
) ;_ 结束entmake
(setq obj3 (entlast))
(command "_.move" obj1 obj2 obj3 "" pt1 (list x y))
(setq xpolar (- (car pt2) (car pt1)))
(setq ypolar (- (cadr pt2) (cadr pt1)))
(setq max-xpolar (max (+ xpolar 5000) max-xpolar))
(setq y (+ ypolar y 1000))
) ;endprogn
) ;endforeach
max-xpolar
) ;_ 结束defun
;;;程序
(vl-load-com)
(defun c:xjss ()
(SETVAR "osmode" 0)
(setvar "cmdecho" 0)
(ly_mak "CONTINUOUS" 1 0 "打印")
(command "-layer" "s" "打印" "")
(setq
filename (getfiled "选择文件夹并任意选取一个文件" "D:/" "dwg" 0)
) ;_ 结束setq
(setq file (vl-filename-directory filename)) ;获取文件夹名称
(setq files (vl-directory-files file "*.dwg" 1))
;获取文件夹中文件名称列表
(setq inspt (getpoint "\n 请输入插入点："))
(jss_insert inspt file files 1)
(command "zoom" "e")
(princ)
) ;_ 结束defun

;; ! *************************************************************************** 
;; ! xd_GetObjectBoundingBox 
;; ! *************************************************************************** 
;; ! 功  能  : 返回实体包围盒的对角点. 
;; ! 参  数  : 'ename' - Any Drawing Object 
;; ! 返回值  : 'Lst' - is a list of LL and UR 
;; ! 说  明  : 适用 AutoCAD 2000+ 
;; ! e-mail  : eachy@xdcad.net 
;; ! Web     : www.xdcad.net 
;; ! **************************************************************************** 
(defun xd_GetObjectBoundingBox (ename / ll ur) 
  (vla-GetBoundingBox (vlax-ename->vla-object ename) 'll 'ur) 
  (list 
    (reverse (cdr (reverse (vlax-safearray->list ll)))) 
    (reverse (cdr (reverse (vlax-safearray->list ur)))) 
  ) ;_ 结束list 
) ;_ 结束defun 
;; ! *************************************************************************** 
;; ! lstf(lst files) 
;; ! *************************************************************************** 
;; ! 功  能  : 从表中提取特殊字段子表. 
;; ! 参  数  : (lst lst需判断的字符串如"CHKPM*" files 表) 
;; ! 返回值  : 'Lstt' - 子表 
;; ! 说  明  : 适用 AutoCAD 2000+ 
;; ! e-mail  : x_s_s_1@163.com 
;; ! **************************************************************************** 
(defun lstf (lst files / i n) 
  (setq i 0) 
  (setq n (length files)) 
  (setq lstt nil) 
  (while (
    (if  (wcmatch (nth i files) lst) 
      (setq lstt (cons (nth i files) lstt)) 
      t 
    )          ;end if 
    (setq i (1+ i)) 
  )          ;end while 
  (setq lstt lstt) 
)          ;end defun 
;;;============================================= 
;;;      通用函数  检查是否存在图层，如无创建之               
;;;参数：l_l------线型(字符串)               
;;;      l_c------颜色(整型)                
;;;      l_s------图层状态(整型)                      
;;;      l_n------图层名(字符串) 
(defun ly_mak (l_l l_c l_s l_n /) 
  (if (= (tblobjname "LAYER" l_n) nil) 
    (progn 
      (entmake (list 
     (cons 0 "LAYER") 
     (cons 100 "AcDbSymbolTableRecord") 
     (cons 100 "AcDbLayerTableRecord") 
     (cons 6 l_l) 
     (cons 62 l_c) 
     (cons 70 l_s) 
     (cons 2 l_n) 
         ) ;_ 结束list 
      ) ;_ 结束entmake 
    ) ;_ 结束progn 
  ) ;_ 结束if 
) ;_ 结束defun 
;;;批量插入子程序 
(defun jss_insert (pt file files scale) 
  (setq  x (car pt) 
  y (cadr pt) 
  ) ;_ 结束setq 
  (setq max-xpolar 0) 
  (foreach name  files 
    (progn 
      (command "-insert" 
         (strcat file "\" name) 
         pt 
         scale 
         scale 
         "0" 
      ) ;_ 结束command 
      (SETQ PTLST (xd_GetObjectBoundingBox (entlast))) 
      (setq obj1 (entlast)) 
      (setq pt1  (polar (list (car (car PTLST)) (cadr (car PTLST))) 
           (* pi 1.25) 
           1000 
    ) ;_ 结束polar 
      ) ;_ 结束setq 
      (setq pt2  (polar (list (car (cadr PTLST)) (cadr (cadr PTLST))) 
           (/ pi 4) 
           1000 
    ) ;_ 结束polar 
      ) ;_ 结束setq 
      (command "RECTANGLE" pt1 pt2) 
      (setq obj2 (entlast)) 
      (entmake (list 
     (cons 0 "TEXT") 
     (cons 1 name) 
     (cons 40 600.0) 
     (cons 41 0.7) 
     (cons 10 (polar pt1 (/ pi 4) 1500)) 
     (cons 50 (/ pi 2)) 
     (cons 8 "吟一手好诗") 
     (cons 7 "hz") 
         ) ;_ 结束list 
      ) ;_ 结束entmake 
      (setq obj3 (entlast)) 
      (command "_.move" obj1 obj2 obj3 "" pt1 (list x y)) 
      (setq xpolar (- (car pt2) (car pt1))) 
      (setq ypolar (- (cadr pt2) (cadr pt1))) 
      (setq max-xpolar (max (+ xpolar 5000) max-xpolar)) 
      (setq y (+ ypolar y 1000)) 
    )          ;endprogn 
  )          ;endforeach 
  max-xpolar 
) ;_ 结束defun 
;;;程序 
(vl-load-com) 
(defun c:xjss () 
  (SETVAR "osmode" 0) 
  (setvar "cmdecho" 0) 
  (ly_mak "CONTINUOUS" 1 0 "打印") 
  (command "-layer" "s" "打印" "") 
  (setq 
    filename (getfiled "选择文件夹并任意选取一个文件" "D:/" "dwg" 0) 
  ) ;_ 结束setq 
  (setq file (vl-filename-directory filename)) ;获取文件夹名称 
  (setq files (vl-directory-files file "*.dwg" 1)) 
          ;获取文件夹中文件名称列表 
  (setq inspt (getpoint "\n 请输入插入点：")) 
   (jss_insert inspt file files 1) 
  (command "zoom" "e") 
  (princ) 
) ;_ 结束defun

kry · 发表于 2014-12-26 16:07:02

x_s_s_1 发表于 2014-12-26 14:45
很烂的代码，自己改改基本思路是一样的，未测试

哈哈，我也想到了，以前一直散的插进来想不明白怎么求包围框。你用xd_GetObjectBoundingBox
求外包不太准，我正在找比较准的外包函数,谢谢了

技术工作室 · 发表于 2023-5-7 15:38:21

是我需要的，支持一下

edsion24 · 发表于 2023-5-10 08:53:32

有最终的解决方案吗

账号		自动登录	找回密码
密码			注册

[提问] 怎么把目录下的DWG批量插入一张图里面并加外框(想不明白怎么加框)

本帖子中包含更多资源