[分享]：关于打印的程序

lijiao · 发表于 2004-2-25 12:14:37

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

自己写的，见笑，请多指教

[FONT=courier new]
;;;打印当前文档
;;;***********************************************************************
(defun c:myplot (/ doc_name plt_name plt_name1 plt_list
plt_ini cur_plt_ini sub_pt_list
pt1 pt2 pt3 pt4 arear1
arear2 biaoji
)
;;; 获取当前文件名称
(setq doc_name (getvar "DWGNAME") bl (getvar "dimscale"))
;;; 判断当前文件是否命名
(if (findfile doc_name)
(progn
;;; 获取文件目录
(setq plt_name (vl-filename-directory (findfile doc_name)))
;;; 生成打印配置文件名称
(setq plt_name (strcat plt_name "\\cs_plot.plt"))
;;; 判断配置文件是否存在
(if (findfile plt_name)
(progn
;;; 读取配置文件内容
(setq plt_list (data_in plt_name))
;;; 是否有当前文件的打印配置
(if (setq cur_plt_ini (assoc doc_name plt_list))
(progn
;;; 显示当前文件的打印配置
(setq pt_list (cdr cur_plt_ini))
(foreach sub_pt_list pt_list
(setq pt1 (car sub_pt_list)
pt3 (cadr sub_pt_list)
pt2 (list (car pt3) (cadr pt1))
pt4 (list (car pt1) (cadr pt3))
)
(grdraw pt1 pt2 1 1)
(grdraw pt2 pt3 1 1)
(grdraw pt3 pt4 1 1)
(grdraw pt4 pt1 1 1)
)
;;;point plot
(if (setq pt1 (getpoint "\n选定打印区域："))
(progn
(setq new_list '()
biaoji nil
)
(foreach arear2 pt_list
(if (pt_in_arear pt1 arear2)
(setq biaoji t
new_list arear2
)
)
)
;;; 点是否在区域内
(if biaoji
(auto_plot (car new_list) (cadr new_list))
(if (setq pt2 (getcorner pt1 "\n对角点："))
(auto_plot pt1 pt2)
)
)
)
)
)
(mpoint_plot)
)
)
(mpoint_plot)
)
)
(mpoint_plot)
)
(redraw)
(princ)
)
(defun mpoint_plot (/ pt1 pt2)
(princ "\n***********选定打印区域*********")
(if (and (setq pt1 (getpoint "\n第一点:"))
(setq pt2 (getcorner pt1 "\n对角点："))
)
(auto_plot pt1 pt2)
)
(princ)
)
;;;自动打印
;;;对于不同的打印机，可以修改本段函数的有关代码
;;;****************************************************************
(defun auto_plot (pt1 pt2 / x1 x2 y1 y2 dx dy)
(setq x1 (car pt1)
y1 (cadr pt1)
x2 (car pt2)
y2 (cadr pt2)
)
(if (> x1 x2)
(setq x1 (car pt2)
x2 (car pt1)
)
)
(if (> y1 y2)
(setq y1 (cadr pt2)
y2 (cadr pt1)
)
)
(setq dx (- x2 x1)
dy (- y2 y1)
)
(setq pt1 (list x1 y1)
pt2 (list x2 y2)
)
(setvar "cmdecho" 0)
(cond
((and (equal dx 287.0 0.0001) (equal dy 180.0 0.001))
(vl-cmdf ".plot"
"y"
""
"hp deskjet 1180c printer.pc3"
"A3 (297 x 420 毫米)"
"m"
"p"
"y"
"w"
pt1
pt2
(/ 1 1.01)
(list 0 0)
"y"
"A4.CTB"
"y"
"n"
"y"
"n"
"a"
"n"
"y"
"y"
)
)
((and (equal dx 267.0 0.0001) (equal dy 200.0 0.001))
(setq pt1 (list (- x1 0.5) (- y1 0.5))
pt2 (list (+ x2 0.5) (+ y2 0.5))
)
(vl-cmdf ".plot" "y" ""
"hp deskjet 1180c printer1.pc3"
"A4 (210 x 297 毫米) " "m" "l"
"y" "w" pt1 pt2
1.0 "圆心" "y" "A4.CTB"
"y" "n" "y" "n"
"a" "n" "y" "y"
)
)
(t
(if (= (strcase (getvar "CTAB")) "MODEL")
(if (> dx dy)
(vl-cmdf ".plot" "y" ""
"hp deskjet 1180c printer.pc3"
"A3 (297 x 420 毫米)" "m"
"l" "y" "w"
pt1 pt2 "f"
"圆心" "y" "A4.CTB"
"y" "a" "n"
"y" "y"
)
(vl-cmdf ".plot"
"y"
""
"hp deskjet 1180c printer.pc3"
"A3 (297 x 420 毫米)"
"m"
"l"
"y"
"w"
pt1
pt2
(/ 1 (* bl 1.01))
(list 220 0)
"y"
"A4.CTB"
"y"
"a"
"n"
"y"
"y"
)
)
(if (> dx dy)
(vl-cmdf ".plot" "y" ""
"hp deskjet 1180c printer.pc3"
"A3 (297 x 420 毫米)" "m" "l"
"y" "w" pt1 pt2
"f" "圆心" "y" "A4.CTB"
"y" "n" "y" "n"
"a" "n" "y" "y"
)
(vl-cmdf ".plot"
"y"
""
"hp deskjet 1180c printer.pc3"
"A3 (297 x 420 毫米)"
"m"
"l"
"y"
"w"
pt1
pt2
(/ 1 (* bl 1.01))
(list 220 0)
"y"
"A4.CTB"
"y"
"n"
"y"
"n"
"a"
"n"
"y"
"y"
)
)
)
)
)
(setvar "cmdecho" 1)
(princ)
)
;;;生成打印设置
;;;******************************************************************
(defun c:crt_plot (/ doc_name plt_name plt_name1
plt_list plt_ini cur_plt_ini
sub_pt_list pt1 pt2
pt3 pt4 arear1 arear2
biaoji
)
;;; 获取当前文件名称
(setq doc_name (getvar "DWGNAME"))
;;; 判断当前文件是否命名
(if (findfile doc_name)
(progn
;;; 获取文件目录
(setq plt_name (vl-filename-directory (findfile doc_name)))
;;; 获取基本文件名称
;;; (setq doc_name (vl-filename-base doc_name))
;;; 生成打印配置文件名称
(setq plt_name (strcat plt_name "\\cs_plot.plt"))
;;; 判断配置文件是否存在
(if (not (findfile plt_name))
(progn
(setq plt_name1 (open plt_name "w"))
(close plt_name1)
)
)
;;; 读取配置文件内容
(setq plt_list (data_in plt_name))
;;; 是否有当前文件的打印配置
(if (setq cur_plt_ini (assoc doc_name plt_list))
(progn
;;; 显示当前文件的打印配置
(setq pt_list (cdr cur_plt_ini))
(foreach sub_pt_list pt_list
(setq pt1 (car sub_pt_list)
pt3 (cadr sub_pt_list)
pt2 (list (car pt3) (cadr pt1))
pt4 (list (car pt1) (cadr pt3))
)
(grdraw pt1 pt2 1 1)
(grdraw pt2 pt3 1 1)
(grdraw pt3 pt4 1 1)
(grdraw pt4 pt1 1 1)
)
)
)
;;;选定打印区域
(if (and (setq
pt1
(getpoint
"\n***************选定打印区域<退出>*********\n第一点:"
)
)
(setq pt2 (getcorner pt1 "\n对角点<退出>："))
)
(progn
(setq arear1 (bzhhqy pt1 pt2)
biaoji nil
)
;;; 判断选定的区域是否存在
(if cur_plt_ini
(progn
(foreach arear2 (cdr cur_plt_ini)
(if (cs_arear_ch arear1 arear2 0.1)
(setq biaoji t)
)
)
(if (not biaoji)
(setq
plt_list (subst (append cur_plt_ini (list arear1))
cur_plt_ini
plt_list
)
)
)
)
(progn
(setq cur_plt_ini (list doc_name arear1))
(setq plt_list (cons cur_plt_ini plt_list))
)
)
(if (not biaoji)
(progn
(data_out plt_name plt_list)
(princ "\n打印区域设置成功。")
)
(princ "\n该打印区域已经存在。")
)
)
)
(redraw)
)
(alert
"**********************************\n 文件未保存，现在退出程序。\n**********************************"
)
)
(princ)
)
;;;数据读入
(defun data_in (file_name / plt_list plt_ini data pt_list)
(setq file_name (open file_name "r"))
(setq plt_list '()
plt_ini '()
)
(while (setq data (read-line file_name))
(setq data (read data))
(if (not plt_ini)
(setq plt_ini (list data))
)
(if (/= (car plt_ini) data)
(setq plt_list (cons plt_ini plt_list)
plt_ini (list data)
)
)
(setq pt_list (list (list (read (read-line file_name))
(read (read-line file_name))
)
(list (read (read-line file_name))
(read (read-line file_name))
)
)
)
(setq plt_ini (append plt_ini (list pt_list)))
)
(close file_name)
(if (or plt_list plt_ini)
(setq plt_list (cons plt_ini plt_list))
)
(reverse plt_list)
)
;;;数据输出
(defun data_out (file_name data / plt_ini doc_name ini_list)
(setq file_name (open file_name "w"))
(foreach plt_ini data
(setq doc_name (car plt_ini))
(foreach ini_list (cdr plt_ini)
(prin1 doc_name file_name)
(princ "\n" file_name)
(princ (car (car ini_list)) file_name)
(princ "\n" file_name)
(princ (cadr (car ini_list)) file_name)
(princ "\n" file_name)
(princ (car (cadr ini_list)) file_name)
(princ "\n" file_name)
(princ (cadr (cadr ini_list)) file_name)
(princ "\n" file_name)
)
)
(close file_name)
)
;;;重定义区域
(defun bzhhqy (pt1 pt2 /)
(list (list (min (car pt1) (car pt2)) (min (cadr pt1) (cadr pt2)))
(list (max (car pt1) (car pt2)) (max (cadr pt1) (cadr pt2)))
)
)
;;;判断两点是否重合
(defun cs_pt_ch (mypt1 mypt2 pre /)
(and (equal (car mypt1) (car mypt2) pre)
(equal (cadr mypt1) (cadr mypt2) pre)
)
)
;;;判断两个区域是否重合
(defun cs_arear_ch (arear1 arear2 pre / mypt1 mypt2
mypt3 mypt4 mypt5 mypt6 mypt7 mypt8
)
(setq mypt1 (car arear1)
mypt2 (cadr arear1)
mypt3 (car arear2)
mypt4 (cadr arear2)
mypt5 (list (min (car mypt1) (car mypt2))
(min (cadr mypt1) (cadr mypt2))
)
mypt6 (list (max (car mypt1) (car mypt2))
(max (cadr mypt1) (cadr mypt2))
)
mypt7 (list (min (car mypt3) (car mypt4))
(min (cadr mypt3) (cadr mypt4))
)
mypt8 (list (max (car mypt3) (car mypt4))
(max (cadr mypt3) (cadr mypt4))
)
)
(and (cs_pt_ch mypt5 mypt7 pre)
(cs_pt_ch mypt6 mypt8 pre)
)
)
;;;判断点是否在一个区域内
(defun pt_in_arear (pt arear / pt1 pt2)
(setq pt1 (car arear)
pt2 (cadr arear)
)
(and (> (car pt) (min (car pt1) (car pt2)))
(< (car pt) (max (car pt1) (car pt2)))
(> (cadr pt) (min (cadr pt1) (cadr pt2)))
(< (cadr pt) (max (cadr pt1) (cadr pt2)))
)
)
;;;*************************************************************************************
;;;删除打印设置
;;;***************************************************************************************
(defun c:del_plot
(/ doc_name plt_name plt_name1
plt_list plt_ini cur_plt_ini
sub_pt_list pt1 pt2
pt3 pt4 arear1 arear2
biaoji new_list
)
;;; 获取当前文件名称
(setq doc_name (getvar "DWGNAME"))
;;; 判断当前文件是否命名
(if (findfile doc_name)
(progn
;;; 获取文件目录
(setq plt_name (vl-filename-directory (findfile doc_name)))
;;; 获取基本文件名称
;;; (setq doc_name (vl-filename-base doc_name))
;;; 生成打印配置文件名称
(setq plt_name (strcat plt_name "\\cs_plot.plt"))
;;; 判断配置文件是否存在
(if (not (findfile plt_name))
(progn
(setq plt_name1 (open plt_name "w"))
(close plt_name1)
)
)
;;; 读取配置文件内容
(setq plt_list (data_in plt_name))
;;; 是否有当前文件的打印配置
(if (setq cur_plt_ini (assoc doc_name plt_list))
(progn
;;; 显示当前文件的打印配置
(setq pt_list (cdr cur_plt_ini))
(foreach sub_pt_list pt_list
(setq pt1 (car sub_pt_list)
pt3 (cadr sub_pt_list)
pt2 (list (car pt3) (cadr pt1))
pt4 (list (car pt1) (cadr pt3))
)
(grdraw pt1 pt2 1 1)
(grdraw pt2 pt3 1 1)
(grdraw pt3 pt4 1 1)
(grdraw pt4 pt1 1 1)
)
(if (setq pt1
(getpoint
"\n***************选定打印区域*********\n在希望删除的区域内点击:"
)
)
(progn
(setq new_list '()
biaoji nil
)
(foreach arear2 (cdr cur_plt_ini)
(if (pt_in_arear pt1 arear2)
(setq biaoji t)
(setq new_list (cons arear2 new_list))
)
)
(if biaoji
(progn
(setq plt_list (subst (cons doc_name new_list)
cur_plt_ini
plt_list
)
)
;;; 输出数据
(data_out plt_name plt_list)
(princ "\n操作成功。")
)
(princ "\n没有选中打印区域。")
)
)
)
)
(alert
"*************************************************\n 没有设置自动打印区域，现在退出程序。\n*************************************************"
)
)
(redraw)
)
(alert
"**********************************\n 文件未保存，现在退出程序。\n**********************************"
)
)
(princ)
)
;;;**************************************************************************
;;;批量打印
;;;如果DVB文件的路径不对，可以修改最后的有关代码
;;;***************************************************************************
(defun c:Mplot (/ cur_path plt_name plt_name1
plt_list plt_ini new_list biaoji
)
(setq cur_path (findfile (getvar "dwgname")))
(if cur_path
(setq cur_path
(strcat (vl-filename-directory (findfile cur_path)) "\")
)
(setq cur_path "")
)
(setq plt_name (getfiled "选择批量打印配置文件" cur_path "plt" 4))
(if plt_name
(progn
;;; 打开配置文件，读取数据
(setq cur_path (strcat (vl-filename-directory plt_name) "\"))
(setq plt_list (data_in plt_name))
;;; 检查图形文件是否存在
(setq new_list '()
biaoji nil
)
(foreach plt_ini plt_list
(if (findfile (strcat cur_path (car plt_ini)))
(setq new_list (cons plt_ini new_list))
(setq biaoji t)
)
)
;;; 图形文件不存在时，删除配置
(if biaoji
(data_out plt_name new_list)
)
;;; 改变路径的表示方法
(while (vl-string-search "\" cur_path)
(setq cur_path (vl-string-subst "/" "\" cur_path))
)
;;; 向VBA传输路径
(set_xrdata "CS2004" "mplot" (list cur_path) nil)
(vl-vbarun "c:\\cs2004\\mplot.dvb!module1.mplot")
)
)
(princ)
)
(vl-load-com)
(defun CADAPP ( / ) (vlax-get-acad-object))
(defun caddoc ( / ) (vla-get-ActiveDocument (cadapp)))
(defun list_to_dxf (lst / biaoji mytype mydata element subelement)
(if (= (type lst) 'list)
(progn
(setq biaoji t
mytype '()
mydata '()
)
(foreach element lst
(cond
((= (type element) 'INT)
(setq mytype (cons 90 mytype))
)
((= (type element) 'real)
(setq mytype (cons 40 mytype))
)
((= (type element) 'STR)
(setq mytype (cons 1 mytype))
)
((= (type element) 'list)
(setq mytype (cons 10 mytype))
(foreach subelement element
(if (and (/= (type subelement) 'int)
(/= (type subelement) 'real)
)
(setq biaoji nil)
)
)
(if biaoji
(setq element (vlax-safearray-fill
(vlax-make-safearray
vlax-vbDouble
(cons 0 (- (length element) 1))
)
element
)
)
)
)
(t (setq biaoji nil))
)
(if biaoji
(setq mydata (cons (vlax-make-variant element) mydata))
)
)
(if biaoji
(setq lst (list (reverse mytype) (reverse mydata)))
)
)
)
)
(defun get_dic (dicname / )
(if (not (caddic dicname))
(vla-add (caddics) dicname)
(caddic dicname)
)
)
(defun caddics ( / ) (vla-get-Dictionaries (caddoc)))
(defun caddic (dicname / mydic)
(setq mydic (vl-catch-all-apply 'vla-item (list (caddics) dicname)))
(if (vl-catch-all-error-p mydic)
nil
mydic
)
)
(defun get_xr (dicname xrname / mydic myxr)
(setq mydic (get_dic dicname))
(if (vl-catch-all-error-p (setq myxr (vl-catch-all-apply 'vla-GetObject (list mydic xrname))))
(setq myxr (vla-AddXRecord mydic xrname))
)
myxr
)
(defun set_xrdata (dicname xrname xrdata YES_or_no / mytype olddata x)
(if (setq xrdata (list_to_dxf xrdata))
(progn
(setq mytype (car xrdata) xrdata (cadr xrdata))
(if (and (setq olddata (get_xrdata dicname xrname)) yes_or_no)
(progn
(setq olddata (list_to_dxf (mapcar '(lambda (x) (cdr x)) olddata)))
(setq oldtype (reverse (car olddata)) olddata (reverse (cadr olddata)))
(foreach x oldtype (setq mytype (cons x mytype)))
(foreach x olddata (setq xrdata (cons x xrdata)))
)
)
(setq mytype (vlax-safearray-fill (vlax-make-safearray vlax-vbInteger (cons 0 (- (length mytype) 1))) mytype)
xrdata (vlax-safearray-fill (vlax-make-safearray vlax-vbVariant (cons 0 (- (length xrdata) 1))) xrdata)
)
(vla-SetXRecordData (get_xr dicname xrname) mytype xrdata)
(princ t)
)
)
)
(defun get_xrdata (dicname xrname / mytype mydata mydatatemp element x y)
(vla-GetXRecordData (get_xr dicname xrname) 'mytype 'mydata)
(if mytype
(progn
(setq mytype (vlax-safearray->list mytype)
mydata (vlax-safearray->list mydata)
)
(setq mydatatemp '())
(foreach element mydata
(setq mydatatemp (cons (vlax-variant-value element) mydatatemp))
)
(setq mydata mydatatemp
mydatatemp '()
)
(foreach element mydata
(if (= (type element) 'safearray)
(setq mydatatemp
(cons (vlax-safearray->list element) mydatatemp)
)
(setq mydatatemp (cons element mydatatemp))
)
)
(setq mydata mydatatemp)
(mapcar '(lambda (x y) (cons x y)) mytype mydata)
)
)
)
(princ "\n程序提供四个命令：CRT_PLOT------生成打印区；DEL_PLOT-----删除打印区；MPLOT－－－打印一个文件夹中的所有文档；MYPLOT－－－打印当前文档")
(princ)
[/FONT]

[FONT=courier new] 
;;;打印当前文档 
;;;*********************************************************************** 
(defun c:myplot        (/            doc_name   plt_name          plt_name1  plt_list 
                 plt_ini    cur_plt_ini                  sub_pt_list 
                 pt1            pt2               pt3          pt4             arear1 
                 arear2            biaoji 
                ) 
;;;  获取当前文件名称 
  (setq doc_name (getvar "DWGNAME")  bl (getvar "dimscale")) 
;;;  判断当前文件是否命名 
  (if (findfile doc_name) 
    (progn 
;;;  获取文件目录 
      (setq plt_name (vl-filename-directory (findfile doc_name))) 
;;;  生成打印配置文件名称 
      (setq plt_name (strcat plt_name "\\cs_plot.plt")) 
;;;  判断配置文件是否存在 
      (if (findfile plt_name) 
        (progn 
;;;  读取配置文件内容 
          (setq plt_list (data_in plt_name)) 
;;;  是否有当前文件的打印配置 
          (if (setq cur_plt_ini (assoc doc_name plt_list)) 
            (progn 
;;;    显示当前文件的打印配置 
              (setq pt_list (cdr cur_plt_ini)) 
              (foreach sub_pt_list pt_list 
                (setq pt1 (car sub_pt_list) 
                      pt3 (cadr sub_pt_list) 
                      pt2 (list (car pt3) (cadr pt1)) 
                      pt4 (list (car pt1) (cadr pt3)) 
                ) 
                (grdraw pt1 pt2 1 1) 
                (grdraw pt2 pt3 1 1) 
                (grdraw pt3 pt4 1 1) 
                (grdraw pt4 pt1 1 1) 
              ) 
;;;point plot 
              (if (setq pt1 (getpoint "\n选定打印区域：")) 
                (progn 
                  (setq        new_list '() 
                        biaoji nil 
                  ) 
                  (foreach arear2 pt_list 
                    (if        (pt_in_arear pt1 arear2) 
                      (setq biaoji t 
                            new_list arear2 
                      ) 
                    ) 
                  ) 
;;;                  点是否在区域内 
                  (if biaoji 
                    (auto_plot (car new_list) (cadr new_list)) 
                    (if        (setq pt2 (getcorner pt1 "\n对角点：")) 
                      (auto_plot pt1 pt2) 
                    ) 
                  ) 
                ) 
              ) 
            ) 
            (mpoint_plot) 
          ) 
        ) 
        (mpoint_plot) 
      ) 
    ) 
    (mpoint_plot) 
  ) 
  (redraw) 
  (princ) 
) 
 
(defun mpoint_plot (/ pt1 pt2) 
  (princ "\n***********选定打印区域*********") 
  (if (and (setq pt1 (getpoint "\n第一点:")) 
           (setq pt2 (getcorner pt1 "\n对角点：")) 
      ) 
    (auto_plot pt1 pt2) 
  ) 
  (princ) 
) 
 
;;;自动打印 
;;;对于不同的打印机，可以修改本段函数的有关代码 
;;;**************************************************************** 
(defun auto_plot (pt1 pt2 / x1 x2 y1 y2 dx dy) 
  (setq        x1 (car pt1) 
        y1 (cadr pt1) 
        x2 (car pt2) 
        y2 (cadr pt2) 
  ) 
  (if (> x1 x2) 
    (setq x1 (car pt2) 
          x2 (car pt1) 
    ) 
  ) 
  (if (> y1 y2) 
    (setq y1 (cadr pt2) 
          y2 (cadr pt1) 
    ) 
  ) 
  (setq        dx (- x2 x1) 
        dy (- y2 y1) 
  ) 
  (setq        pt1 (list x1 y1) 
        pt2 (list x2 y2) 
  ) 
  (setvar "cmdecho" 0) 
  (cond 
    ((and (equal dx 287.0 0.0001) (equal dy 180.0 0.001)) 
     (vl-cmdf ".plot" 
              "y" 
              "" 
              "hp deskjet 1180c printer.pc3" 
              "A3 (297 x 420 毫米)" 
              "m" 
              "p" 
              "y" 
              "w" 
              pt1 
              pt2 
              (/ 1 1.01) 
              (list 0 0) 
              "y" 
              "A4.CTB" 
              "y" 
              "n" 
              "y" 
              "n" 
              "a" 
              "n" 
              "y" 
              "y" 
     ) 
    ) 
    ((and (equal dx 267.0 0.0001) (equal dy 200.0 0.001)) 
     (setq pt1 (list (- x1 0.5) (- y1 0.5)) 
           pt2 (list (+ x2 0.5) (+ y2 0.5)) 
     ) 
     (vl-cmdf ".plot"            "y"                  "" 
              "hp deskjet 1180c printer1.pc3" 
              "A4 (210 x 297 毫米) "          "m"                "l" 
              "y"            "w"                  pt1                pt2 
              1.0            "圆心"          "y"                "A4.CTB" 
              "y"            "n"                  "y"                "n" 
              "a"            "n"                  "y"                "y" 
             ) 
    ) 
    (t 
     (if (= (strcase (getvar "CTAB")) "MODEL") 
       (if (> dx dy) 
         (vl-cmdf ".plot"        "y"              "" 
                  "hp deskjet 1180c printer.pc3" 
                  "A3 (297 x 420 毫米)"              "m" 
                  "l"                "y"              "w" 
                  pt1                pt2              "f" 
                  "圆心"        "y"              "A4.CTB" 
                  "y"                "a"              "n" 
                  "y"                "y" 
                 ) 
         (vl-cmdf ".plot" 
                  "y" 
                  "" 
                  "hp deskjet 1180c printer.pc3" 
                  "A3 (297 x 420 毫米)" 
                  "m" 
                  "l" 
                  "y" 
                  "w" 
                  pt1 
                  pt2 
                  (/ 1 (* bl 1.01)) 
                  (list 220 0) 
                  "y" 
                  "A4.CTB" 
                  "y" 
                  "a" 
                  "n" 
                  "y" 
                  "y" 
         ) 
       ) 
       (if (> dx dy) 
         (vl-cmdf ".plot"      "y"            "" 
                  "hp deskjet 1180c printer.pc3" 
                  "A3 (297 x 420 毫米)"            "m"                 "l" 
                  "y"               "w"            pt1                 pt2 
                  "f"               "圆心"            "y"                 "A4.CTB" 
                  "y"               "n"            "y"                 "n" 
                  "a"               "n"            "y"                 "y" 
                 ) 
         (vl-cmdf ".plot" 
                  "y" 
                  "" 
                  "hp deskjet 1180c printer.pc3" 
                  "A3 (297 x 420 毫米)" 
                  "m" 
                  "l" 
                  "y" 
                  "w" 
                  pt1 
                  pt2 
                  (/ 1 (* bl 1.01)) 
                  (list 220 0) 
                  "y" 
                  "A4.CTB" 
                  "y" 
                  "n" 
                  "y" 
                  "n" 
                  "a" 
                  "n" 
                  "y" 
                  "y" 
         ) 
       ) 
     ) 
    ) 
  ) 
  (setvar "cmdecho" 1) 
  (princ) 
) 
 
;;;生成打印设置 
;;;****************************************************************** 
(defun c:crt_plot (/              doc_name         plt_name   plt_name1 
                   plt_list   plt_ini         cur_plt_ini 
                   sub_pt_list                 pt1            pt2 
                   pt3              pt4         arear1            arear2 
                   biaoji 
                  ) 
;;;  获取当前文件名称 
  (setq doc_name (getvar "DWGNAME")) 
;;;  判断当前文件是否命名 
  (if (findfile doc_name) 
    (progn 
;;;  获取文件目录 
      (setq plt_name (vl-filename-directory (findfile doc_name))) 
;;;  获取基本文件名称 
;;;      (setq doc_name (vl-filename-base doc_name)) 
;;;  生成打印配置文件名称 
      (setq plt_name (strcat plt_name "\\cs_plot.plt")) 
;;;  判断配置文件是否存在 
      (if (not (findfile plt_name)) 
        (progn 
          (setq plt_name1 (open plt_name "w")) 
          (close plt_name1) 
        ) 
      ) 
;;;  读取配置文件内容 
      (setq plt_list (data_in plt_name)) 
;;;  是否有当前文件的打印配置 
      (if (setq cur_plt_ini (assoc doc_name plt_list)) 
        (progn 
;;;    显示当前文件的打印配置 
          (setq pt_list (cdr cur_plt_ini)) 
          (foreach sub_pt_list pt_list 
            (setq pt1 (car sub_pt_list) 
                  pt3 (cadr sub_pt_list) 
                  pt2 (list (car pt3) (cadr pt1)) 
                  pt4 (list (car pt1) (cadr pt3)) 
            ) 
            (grdraw pt1 pt2 1 1) 
            (grdraw pt2 pt3 1 1) 
            (grdraw pt3 pt4 1 1) 
            (grdraw pt4 pt1 1 1) 
          ) 
        ) 
      ) 
;;;选定打印区域 
      (if (and (setq 
                 pt1 
                  (getpoint 
                    "\n***************选定打印区域<退出>*********\n第一点:" 
                  ) 
               ) 
               (setq pt2 (getcorner pt1 "\n对角点<退出>：")) 
          ) 
        (progn 
          (setq        arear1 (bzhhqy pt1 pt2) 
                biaoji nil 
          ) 
;;;      判断选定的区域是否存在 
          (if cur_plt_ini 
            (progn 
              (foreach arear2 (cdr cur_plt_ini) 
                (if (cs_arear_ch arear1 arear2 0.1) 
                  (setq biaoji t) 
                ) 
              ) 
              (if (not biaoji) 
                (setq 
                  plt_list (subst (append cur_plt_ini (list arear1)) 
                                  cur_plt_ini 
                                  plt_list 
                           ) 
                ) 
              ) 
            ) 
            (progn 
              (setq cur_plt_ini (list doc_name arear1)) 
              (setq plt_list (cons cur_plt_ini plt_list)) 
            ) 
          ) 
          (if (not biaoji) 
            (progn 
              (data_out plt_name plt_list) 
              (princ "\n打印区域设置成功。") 
            ) 
            (princ "\n该打印区域已经存在。") 
          ) 
        ) 
      ) 
      (redraw) 
    ) 
    (alert 
      "**********************************\n     文件未保存，现在退出程序。\n**********************************" 
    ) 
  ) 
  (princ) 
) 
 
 
 
;;;数据读入 
(defun data_in (file_name / plt_list plt_ini data pt_list) 
  (setq file_name (open file_name "r")) 
  (setq        plt_list '() 
        plt_ini        '() 
  ) 
  (while (setq data (read-line file_name)) 
    (setq data (read data)) 
    (if        (not plt_ini) 
      (setq plt_ini (list data)) 
    ) 
    (if        (/= (car plt_ini) data) 
      (setq plt_list (cons plt_ini plt_list) 
            plt_ini  (list data) 
      ) 
    ) 
    (setq pt_list (list        (list (read (read-line file_name)) 
                              (read (read-line file_name)) 
                        ) 
                        (list (read (read-line file_name)) 
                              (read (read-line file_name)) 
                        ) 
                  ) 
    ) 
    (setq plt_ini (append plt_ini (list pt_list))) 
  ) 
  (close file_name) 
  (if (or plt_list plt_ini) 
    (setq plt_list (cons plt_ini plt_list)) 
  ) 
  (reverse plt_list) 
) 
;;;数据输出 
(defun data_out        (file_name data / plt_ini doc_name ini_list) 
  (setq file_name (open file_name "w")) 
  (foreach plt_ini data 
    (setq doc_name (car plt_ini)) 
    (foreach ini_list (cdr plt_ini) 
      (prin1 doc_name file_name) 
      (princ "\n" file_name) 
      (princ (car (car ini_list)) file_name) 
      (princ "\n" file_name) 
      (princ (cadr (car ini_list)) file_name) 
      (princ "\n" file_name) 
      (princ (car (cadr ini_list)) file_name) 
      (princ "\n" file_name) 
      (princ (cadr (cadr ini_list)) file_name) 
      (princ "\n" file_name) 
    ) 
  ) 
  (close file_name) 
) 
;;;重定义区域 
(defun bzhhqy (pt1 pt2 /) 
  (list        (list (min (car pt1) (car pt2)) (min (cadr pt1) (cadr pt2))) 
        (list (max (car pt1) (car pt2)) (max (cadr pt1) (cadr pt2))) 
  ) 
) 
;;;判断两点是否重合 
(defun cs_pt_ch        (mypt1 mypt2 pre /) 
  (and (equal (car mypt1) (car mypt2) pre) 
       (equal (cadr mypt1) (cadr mypt2) pre) 
  ) 
) 
;;;判断两个区域是否重合 
(defun cs_arear_ch (arear1  arear2  pre            /            mypt1   mypt2 
                    mypt3   mypt4   mypt5   mypt6   mypt7   mypt8 
                   ) 
  (setq        mypt1 (car arear1) 
        mypt2 (cadr arear1) 
        mypt3 (car arear2) 
        mypt4 (cadr arear2) 
        mypt5 (list (min (car mypt1) (car mypt2)) 
                    (min (cadr mypt1) (cadr mypt2)) 
              ) 
        mypt6 (list (max (car mypt1) (car mypt2)) 
                    (max (cadr mypt1) (cadr mypt2)) 
              ) 
        mypt7 (list (min (car mypt3) (car mypt4)) 
                    (min (cadr mypt3) (cadr mypt4)) 
              ) 
        mypt8 (list (max (car mypt3) (car mypt4)) 
                    (max (cadr mypt3) (cadr mypt4)) 
              ) 
  ) 
  (and (cs_pt_ch mypt5 mypt7 pre) 
       (cs_pt_ch mypt6 mypt8 pre) 
  ) 
) 
;;;判断点是否在一个区域内 
(defun pt_in_arear (pt arear / pt1 pt2) 
  (setq        pt1 (car arear) 
        pt2 (cadr arear) 
  ) 
  (and (> (car pt) (min (car pt1) (car pt2))) 
       (< (car pt) (max (car pt1) (car pt2))) 
       (> (cadr pt) (min (cadr pt1) (cadr pt2))) 
       (< (cadr pt) (max (cadr pt1) (cadr pt2))) 
  ) 
) 
;;;************************************************************************************* 
 
 
;;;删除打印设置 
;;;*************************************************************************************** 
(defun c:del_plot 
                  (/              doc_name         plt_name   plt_name1 
                   plt_list   plt_ini         cur_plt_ini 
                   sub_pt_list                 pt1            pt2 
                   pt3              pt4         arear1            arear2 
                   biaoji     new_list 
                  ) 
;;;  获取当前文件名称 
  (setq doc_name (getvar "DWGNAME")) 
;;;  判断当前文件是否命名 
  (if (findfile doc_name) 
    (progn 
;;;  获取文件目录 
      (setq plt_name (vl-filename-directory (findfile doc_name))) 
;;;  获取基本文件名称 
;;;      (setq doc_name (vl-filename-base doc_name)) 
;;;  生成打印配置文件名称 
      (setq plt_name (strcat plt_name "\\cs_plot.plt")) 
;;;  判断配置文件是否存在 
      (if (not (findfile plt_name)) 
        (progn 
          (setq plt_name1 (open plt_name "w")) 
          (close plt_name1) 
        ) 
      ) 
;;;  读取配置文件内容 
      (setq plt_list (data_in plt_name)) 
;;;  是否有当前文件的打印配置 
      (if (setq cur_plt_ini (assoc doc_name plt_list)) 
        (progn 
;;;    显示当前文件的打印配置 
          (setq pt_list (cdr cur_plt_ini)) 
          (foreach sub_pt_list pt_list 
            (setq pt1 (car sub_pt_list) 
                  pt3 (cadr sub_pt_list) 
                  pt2 (list (car pt3) (cadr pt1)) 
                  pt4 (list (car pt1) (cadr pt3)) 
            ) 
            (grdraw pt1 pt2 1 1) 
            (grdraw pt2 pt3 1 1) 
            (grdraw pt3 pt4 1 1) 
            (grdraw pt4 pt1 1 1) 
          ) 
          (if (setq pt1 
                     (getpoint 
                       "\n***************选定打印区域*********\n在希望删除的区域内点击:" 
                     ) 
              ) 
            (progn 
              (setq new_list '() 
                    biaoji nil 
              ) 
              (foreach arear2 (cdr cur_plt_ini) 
                (if (pt_in_arear pt1 arear2) 
                  (setq biaoji t) 
                  (setq new_list (cons arear2 new_list)) 
                ) 
              ) 
 
              (if biaoji 
                (progn 
                  (setq        plt_list (subst        (cons doc_name new_list) 
                                        cur_plt_ini 
                                        plt_list 
                                 ) 
                  ) 
;;;                  输出数据 
                  (data_out plt_name plt_list) 
                  (princ "\n操作成功。") 
                ) 
                (princ "\n没有选中打印区域。") 
              ) 
            ) 
          ) 
        ) 
        (alert 
          "*************************************************\n        没有设置自动打印区域，现在退出程序。\n*************************************************" 
        ) 
      ) 
      (redraw) 
    ) 
    (alert 
      "**********************************\n     文件未保存，现在退出程序。\n**********************************" 
    ) 
  ) 
  (princ) 
) 
 
;;;************************************************************************** 
 
;;;批量打印 
;;;如果DVB文件的路径不对，可以修改最后的有关代码 
;;;*************************************************************************** 
(defun c:Mplot (/            cur_path        plt_name    plt_name1 
                plt_list    plt_ini        new_list    biaoji 
               ) 
  (setq cur_path (findfile (getvar "dwgname"))) 
  (if cur_path 
    (setq cur_path 
           (strcat (vl-filename-directory (findfile cur_path)) "\") 
    ) 
    (setq cur_path "") 
  ) 
  (setq plt_name (getfiled "选择批量打印配置文件" cur_path "plt" 4)) 
  (if plt_name 
    (progn 
;;;      打开配置文件，读取数据 
      (setq cur_path (strcat (vl-filename-directory plt_name) "\")) 
      (setq plt_list (data_in plt_name)) 
;;;      检查图形文件是否存在 
      (setq new_list '() 
            biaoji nil 
      ) 
      (foreach plt_ini plt_list 
        (if (findfile (strcat cur_path (car plt_ini))) 
          (setq new_list (cons plt_ini new_list)) 
          (setq biaoji t) 
        ) 
      ) 
;;;      图形文件不存在时，删除配置 
      (if biaoji 
        (data_out plt_name new_list) 
      ) 
;;;      改变路径的表示方法 
      (while (vl-string-search "\" cur_path) 
        (setq cur_path (vl-string-subst "/" "\" cur_path)) 
      ) 
;;;      向VBA传输路径 
      (set_xrdata "CS2004" "mplot" (list cur_path) nil) 
      (vl-vbarun "c:\\cs2004\\mplot.dvb!module1.mplot") 
    ) 
  ) 
  (princ) 
) 
 
(vl-load-com) 
(defun CADAPP ( / )  (vlax-get-acad-object)) 
(defun caddoc ( / ) (vla-get-ActiveDocument (cadapp))) 
(defun list_to_dxf (lst / biaoji mytype mydata element subelement) 
  (if (= (type lst) 'list) 
    (progn 
      (setq biaoji t 
            mytype '() 
            mydata '() 
      ) 
      (foreach element lst 
        (cond 
          ((= (type element) 'INT) 
           (setq mytype (cons 90 mytype)) 
          ) 
          ((= (type element) 'real) 
           (setq mytype (cons 40 mytype)) 
          ) 
          ((= (type element) 'STR) 
           (setq mytype (cons 1 mytype)) 
          ) 
          ((= (type element) 'list) 
           (setq mytype (cons 10 mytype)) 
           (foreach subelement element 
             (if (and (/= (type subelement) 'int) 
                      (/= (type subelement) 'real) 
                 ) 
               (setq biaoji nil) 
             ) 
           ) 
           (if biaoji 
             (setq element (vlax-safearray-fill 
                             (vlax-make-safearray 
                               vlax-vbDouble 
                               (cons 0 (- (length element) 1)) 
                             ) 
                             element 
                           ) 
             ) 
           ) 
          ) 
          (t (setq biaoji nil)) 
        ) 
        (if biaoji 
          (setq mydata (cons (vlax-make-variant element) mydata)) 
        ) 
      ) 
      (if biaoji 
        (setq lst (list (reverse mytype) (reverse mydata))) 
      ) 
    ) 
  ) 
) 
(defun get_dic (dicname / ) 
  (if (not  (caddic dicname)) 
     (vla-add (caddics) dicname) 
    (caddic dicname) 
    ) 
  ) 
(defun caddics ( / ) (vla-get-Dictionaries (caddoc))) 
(defun caddic (dicname / mydic) 
  (setq mydic (vl-catch-all-apply 'vla-item (list (caddics) dicname))) 
  (if (vl-catch-all-error-p mydic) 
    nil 
     mydic 
    ) 
  ) 
(defun get_xr (dicname xrname / mydic myxr) 
  (setq mydic (get_dic dicname)) 
  (if (vl-catch-all-error-p (setq myxr (vl-catch-all-apply 'vla-GetObject (list mydic xrname)))) 
    (setq myxr (vla-AddXRecord mydic xrname)) 
    ) 
  myxr 
  ) 
(defun set_xrdata (dicname xrname xrdata YES_or_no / mytype olddata x) 
  (if (setq xrdata (list_to_dxf xrdata)) 
    (progn 
      (setq mytype (car xrdata) xrdata (cadr xrdata)) 
      (if (and (setq olddata (get_xrdata dicname xrname)) yes_or_no) 
        (progn 
          (setq olddata (list_to_dxf (mapcar '(lambda (x) (cdr x)) olddata))) 
          (setq oldtype (reverse (car olddata)) olddata (reverse (cadr olddata))) 
          (foreach x  oldtype (setq mytype (cons x mytype))) 
          (foreach x  olddata (setq xrdata (cons x xrdata))) 
          ) 
        ) 
      (setq mytype (vlax-safearray-fill (vlax-make-safearray vlax-vbInteger  (cons 0 (- (length mytype) 1)))  mytype) 
            xrdata (vlax-safearray-fill (vlax-make-safearray vlax-vbVariant   (cons 0 (- (length xrdata) 1)))  xrdata) 
            ) 
      (vla-SetXRecordData (get_xr dicname xrname) mytype xrdata) 
      (princ t) 
      ) 
    ) 
  ) 
(defun get_xrdata (dicname xrname / mytype mydata mydatatemp element x y) 
  (vla-GetXRecordData (get_xr dicname xrname) 'mytype 'mydata) 
  (if mytype 
    (progn 
      (setq mytype (vlax-safearray->list mytype) 
            mydata (vlax-safearray->list mydata) 
      ) 
      (setq mydatatemp '()) 
      (foreach element mydata 
        (setq mydatatemp (cons (vlax-variant-value element) mydatatemp)) 
      ) 
      (setq mydata     mydatatemp 
            mydatatemp '() 
      ) 
      (foreach element mydata 
        (if (= (type element) 'safearray) 
          (setq        mydatatemp 
                 (cons (vlax-safearray->list element) mydatatemp) 
          ) 
          (setq mydatatemp (cons element mydatatemp)) 
        ) 
      ) 
      (setq mydata mydatatemp) 
      (mapcar '(lambda (x y) (cons x y)) mytype mydata) 
    ) 
  ) 
) 
(princ "\n程序提供四个命令：CRT_PLOT------生成打印区；DEL_PLOT-----删除打印区；MPLOT－－－打印一个文件夹中的所有文档；MYPLOT－－－打印当前文档") 
(princ) 
  [/FONT]

lijiao · 发表于 2004-2-25 16:09:23

DVB文件

lijiao · 发表于 2004-2-25 16:20:44

示例

xiaomai9 · 发表于 2004-5-13 23:06:36

能不能增加一个功能，打印当前所有的已经打开的文件或者打印指定的多个文件（从文件选择对话框中多选）？

lzy9788 · 发表于 2004-5-14 09:25:44

长老，你那个宏怎么运行不了？

lijiao · 发表于 2004-5-14 13:20:42

它不单独运行，是由LSP调用，因为它需要LSP给它传输数据。
这段程序有它的特殊性，针对不同的硬件配置，程序需要局部调整，主要指auto_plot 程序段，所以我提供源代码，供各位修改方便。

zhouyxcs · 发表于 2004-6-12 12:14:14

打印到文件后如何打出来呢?

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

[分享]：关于打印的程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块