利用论坛收集的函数，发个按照编号打印图纸的程序

newbuser · 发表于 2013-12-22 08:43:46

本帖最后由 newbuser 于 2013-12-22 08:48 编辑

本人菜鸟级水平，利用论坛搜集的函数，组装了个自己觉得平时工作用的到的一顺序打印程序，希望能够帮到有用之人。

;;需建立打印每幅图范围多段线图框及编号，并且令其处于同一图层
;;主程序
(defun c:sxdy ( / cmd doc e2 el2 i i2 itm lst lst1 lst2 msg n os p1 p3 sgel ss1 ss2 tc xy)
(defun *error* (msg)
(setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量
(setvar "osmode" os) ;_ 恢复osmode系统变量
(princ "error: ")
(princ msg) ;_ 打印错误信息
(princ)
)
(setq cmd (getvar "cmdecho")) ;_ 保存系统变量cmdecho值
(setq os (getvar "osmode"))
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-StartUndoMark doc)
(setvar "osmode" 0)
(setq tc (assoc 8 (entget (car (entsel "\n 请选任选一打印序号==>> ")))))
(command "-layer" "p" "n" (cdr tc) "")
(print "\n 请选择需要打印范围的图框==>>")
;同时获取图框选择集ss1 文字选择集ss2
(setq ss1 nil ss2 nil)
(if (setq ss1 (ssget (list (cons 0 "TEXT,LWPOLYLINE") tc)))
(foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
(if (= (cdr (assoc 0 (entget itm))) "TEXT")
(progn
(or ss2 (setq ss2 (ssadd)))
(ssadd itm ss2)
(ssdel itm ss1)
)
)
)
)
(setq i2 0)
(setq lst2 nil)
(repeat (sslength ss2)
(setq e2 (ssname ss2 i2))
(setq el2 (entget e2))
(setq lst2 (append lst2 (list (list (read (cdr (assoc 1 el2))) (assoc 10 el2)))))
(setq i2 (1+ i2))
)
(setq lst2 (sort lst2)) ;;已经按图框内数字1,2,3,4进行排序的表lst2 ((序号1 (10 三维点)) (序号2 (10 三维点)))
(setq lst2 (vl lst2)) ;;去掉lst2中的序号，重组序号表 lst2
(lstlw ss1) ;; 得到图框角点坐标表lst1
(setq n 0)
(setq lst nil)
(repeat (length lst2)
(setq sgel (nth n lst2)) ;;获取单个序号坐标
(setq lst (append lst (pp sgel lst1))) ;;得到对应图框坐标表
(setq n (1+ n))
)
(setq i 0)
(repeat (length lst)
(setq xy (nth i lst))
(setq p1 (car xy))
(setq p3 (cadr (cdr xy)))
(command "zoom" "w" p1 p3)
(command "-plot" "y" ; 是否需要详细打印配置
"模型" ; 输入布局、模型名称
"pdfFactory Pro" ; 输入输出设备的名称此处例举虚拟打印机 pdfFactory Pro
; (lisp语言中的一个 \ 符号需要用 \\符号表示，即\=>\\)
; 例如：共享打印机 \\Adminstractor\Kyocera KM-2560 KX应该表示为\\\\Adminstractor\\Kyocera KM-2560 KX
"A4" ; 输入图纸尺寸A4
"m" ; 输入图纸单位(I:英寸 M:毫米)
"l" ; 输入图形方向(纵向:P 横向:L)
"n" ; 是否反向打印
"w" ; 输入打印区域(显示:D范围:E图形界限:L 视图:V 窗口:W)
p1 ; 打印图框左下角点坐标
p3 ; 打印图框右上角点坐标
"f" ; 输入打印比例(F:布满)
"c" ; 输入打印偏移(居中打印:C)
"y" ; 是否按样式打印
"acad.ctb" ; 输入打印样式名称
"y" ; 是否打印线宽
"a" ; 输入着色打印设置(按显示:A 线框:W
; 消隐:H 渲染:R)
"n" ; 是否打印到文件
"n" ; 是否保存对页面设置的修改
"y" ; 是否继续打印
)
(setq i (+ i 1))
)
(setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量
(setvar "osmode" os) ;_ 恢复osmode系统变量
(vla-EndUndoMark doc)
(vlax-release-object doc)
(princ)
)
;获取图框集合多段线点表总表
(defun lstlw (ss)
(setq i1 0)
(setq lst1 nil)
(repeat (sslength ss)
(setq e1 (ssname ss i1))
(setq el1 (LWPL e1))
(setq lst1 (append lst1 (list el1)))
(setq i1 (1+ i1))
)
)
;获取多段线点表函数
(defun LWPL (x /)
(vl-remove-if
'not
(mapcar
'(lambda (x)
(if (= (car x) 10)
(append (cdr x) '(0))
)
)
(entget x)
)
)
)
;;将((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)))中的序号1 2去掉
(defun vl (lst)
(mapcar '(lambda (x)
(cdr (car (cdr x)))
)
lst
)
)
;;提取出对应单个图框的坐标表
(defun pp (pt lst)
(vl-remove-if
'not
(mapcar
'(lambda (x)
(if (= T (isPtinPM pt x))
x
)
)
lst
)
)
)
;;根据文字内容进行表排序
(defun sort (LST / REC)
(defun REC (A B)
;;递归
(cond ((equal (car A) (car B) 1E-4)
(REC (cdr A) (cdr B))
)
(T (< (car A) (car B)))
)
)
(vl-sort LST '(lambda (P1 P2) (REC P1 P2)))
)
;;eg:((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)) (3 (10 2284.33 603.215 0.0)))
;;;******************************************************************************
;;; No.51 判断点是否在多边形内(狂刀程序)
;;;xPt是要判断的点坐标(x y z ), Points是多边形顶点列表((x1 y1 z1) (x2 y2 z2)...)
;;;******************************************************************************
(defun isPtinPM (xPt Points)
(equal
PI
(abs
(apply
'+
(mapcar '(lambda (x y) (rem (- (angle xPt x) (angle xPt y)) PI))
(reverse (cdr (reverse (cons (last Points) Points))))
Points
)
)
)
1e-6
) ;end_equal
) ;end_defun

;;需建立打印每幅图范围多段线图框及编号，并且令其处于同一图层 
;;主程序 
(defun c:sxdy ( / cmd doc e2 el2 i i2 itm lst lst1 lst2 msg n os p1 p3 sgel ss1 ss2 tc xy) 
    (defun *error* (msg) 
    (setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量 
    (setvar "osmode" os) ;_ 恢复osmode系统变量 
    (princ "error: ") 
    (princ msg) ;_ 打印错误信息 
    (princ) 
  ) 
  (setq cmd (getvar "cmdecho")) ;_ 保存系统变量cmdecho值 
  (setq os (getvar "osmode")) 
  (setq doc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-StartUndoMark doc) 
  (setvar "osmode" 0) 
  (setq tc (assoc 8 (entget (car (entsel "\n 请选任选一打印序号==>> "))))) 
  (command "-layer" "p" "n" (cdr tc) "") 
  (print "\n 请选择需要打印范围的图框==>>") 
  ;同时获取图框选择集ss1 文字选择集ss2 
  (setq ss1 nil ss2 nil) 
  (if (setq ss1 (ssget (list (cons 0 "TEXT,LWPOLYLINE") tc))) 
    (foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))) 
      (if (= (cdr (assoc 0 (entget itm))) "TEXT") 
        (progn 
          (or ss2 (setq ss2 (ssadd))) 
          (ssadd itm ss2) 
          (ssdel itm ss1) 
        ) 
      ) 
    ) 
  ) 
(setq i2 0) 
(setq lst2 nil) 
(repeat (sslength ss2) 
  (setq e2 (ssname ss2 i2)) 
  (setq el2 (entget e2)) 
  (setq lst2 (append lst2 (list (list (read (cdr (assoc 1 el2))) (assoc 10 el2))))) 
  (setq i2 (1+ i2)) 
  ) 
  (setq lst2 (sort lst2))     ;;已经按图框内数字1,2,3,4进行排序的表lst2 ((序号1 (10 三维点)) (序号2 (10 三维点))) 
  (setq lst2 (vl lst2))       ;;去掉lst2中的序号，重组序号表 lst2 
  (lstlw ss1)                 ;; 得到图框角点坐标表lst1          
  (setq n 0) 
  (setq lst nil) 
  (repeat (length lst2) 
    (setq sgel (nth n lst2))   ;;获取单个序号坐标 
    (setq lst (append lst  (pp sgel lst1)))  ;;得到对应图框坐标表 
    (setq n (1+ n)) 
    ) 
  (setq i 0) 
  (repeat (length lst) 
    (setq xy (nth i lst)) 
    (setq p1 (car xy)) 
    (setq p3 (cadr (cdr xy))) 
    (command "zoom" "w" p1 p3) 
    (command "-plot" "y"         ; 是否需要详细打印配置 
       "模型"           ; 输入布局、模型名称 
       "pdfFactory Pro"         ; 输入输出设备的名称  此处例举虚拟打印机 pdfFactory Pro 
                                       ; (lisp语言中的一个 \ 符号需要用 \\符号表示，即\=>\\) 
                                 ; 例如：共享打印机 \\Adminstractor\Kyocera KM-2560 KX应该表示为\\\\Adminstractor\\Kyocera KM-2560 KX 
       "A4"           ; 输入图纸尺寸A4 
       "m"           ; 输入图纸单位(I:英寸 M:毫米) 
       "l"           ; 输入图形方向(纵向:P 横向:L) 
       "n"           ; 是否反向打印 
       "w"           ; 输入打印区域(显示:D范围:E图形界限:L 视图:V 窗口:W) 
       p1                   ; 打印图框左下角点坐标 
       p3                   ; 打印图框右上角点坐标 
       "f"           ; 输入打印比例(F:布满) 
       "c"           ; 输入打印偏移(居中打印:C) 
       "y"           ; 是否按样式打印 
       "acad.ctb"           ; 输入打印样式名称 
       "y"           ; 是否打印线宽 
       "a"           ; 输入着色打印设置(按显示:A 线框:W 
               ; 消隐:H 渲染:R) 
       "n"           ; 是否打印到文件 
       "n"           ; 是否保存对页面设置的修改 
       "y"           ; 是否继续打印 
    ) 
    (setq i (+ i 1)) 
  ) 
    (setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量 
  (setvar "osmode" os)   ;_ 恢复osmode系统变量 
  (vla-EndUndoMark doc) 
  (vlax-release-object doc) 
  (princ) 
) 
   
;获取图框集合多段线点表总表 
(defun lstlw (ss) 
  (setq i1 0) 
  (setq lst1 nil) 
  (repeat (sslength ss) 
    (setq e1 (ssname ss i1)) 
    (setq el1 (LWPL e1)) 
    (setq lst1 (append lst1 (list el1))) 
    (setq i1 (1+ i1)) 
  ) 
) 
;获取多段线点表函数 
(defun LWPL (x /) 
  (vl-remove-if 
    'not 
    (mapcar 
      '(lambda (x) 
   (if (= (car x) 10) 
     (append (cdr x) '(0)) 
   ) 
       ) 
      (entget x) 
    ) 
  ) 
) 
 
 
;;将((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)))中的序号1 2去掉 
 (defun  vl (lst) 
   (mapcar '(lambda (x) 
 
        (cdr (car (cdr x))) 
      ) 
     lst 
   ) 
 ) 
 
 
;;提取出对应单个图框的坐标表 
 
(defun pp (pt lst) 
  (vl-remove-if 
    'not 
    (mapcar 
      '(lambda (x) 
   (if (= T (isPtinPM pt x)) 
     x 
   ) 
       ) 
      lst 
    ) 
  ) 
) 
 
;;根据文字内容进行表排序 
(defun sort (LST / REC) 
  (defun REC (A B) 
    ;;递归 
    (cond ((equal (car A) (car B) 1E-4) 
     (REC (cdr A) (cdr B)) 
    ) 
    (T (< (car A) (car B))) 
    ) 
  ) 
  (vl-sort LST '(lambda (P1 P2) (REC P1 P2))) 
) 
;;eg:((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)) (3 (10 2284.33 603.215 0.0))) 
 
;;;****************************************************************************** 
;;; No.51  判断点是否在多边形内(狂刀程序)                                        
;;;xPt是要判断的点坐标(x y z ), Points是多边形顶点列表((x1 y1 z1) (x2 y2 z2)...) 
;;;****************************************************************************** 
(defun isPtinPM  (xPt Points) 
  (equal 
    PI 
    (abs 
      (apply 
  '+ 
  (mapcar  '(lambda (x y) (rem (- (angle xPt x) (angle xPt y)) PI)) 
    (reverse (cdr (reverse (cons (last Points) Points)))) 
    Points 
  ) 
      ) 
    ) 
    1e-6 
  )          ;end_equal 
)          ;end_defun

w245272914 · 发表于 2017-12-22 14:56:54

楼主，你的程序只单一方向（纵向或者横向），能不能智能识别并智能旋转啊，这样实用性更高，望重新改善后的程序并共享下源码，感谢了。

zhangcan0515 · 发表于 2017-10-20 09:31:00

试试看看看起来比较实用

ZZXXQQ · 发表于 2013-12-22 10:01:51

(defun vl (lst) (mapcar 'cdadr lst))

newbuser · 发表于 2013-12-22 10:32:20

ZZXXQQ 发表于 2013-12-22 10:01
(defun vl (lst) (mapcar 'cdadr lst))

感谢ZZXXQQ版主的简化思路。

清风明月名字 · 发表于 2013-12-22 12:55:57

运行效果良好，有时间慢慢研究

清风明月名字 · 发表于 2013-12-22 19:05:25

是啊，我爱好这些，也天天写，也收集

llsheng_73 · 发表于 2013-12-22 22:43:01

对于其中的点在不在线内的问题最让我郁闷，由于CAD本身或者是取位的原因，明明在线上的点可能会被判为不在线上，甚至碰到过两条线的公共顶点结果它不在另一条线上，给来了个互不相认，弄得我没办法，只好先判断点到线的距离是不是小到可以认为它在线上，然后再去对线进行偏移，比较偏移前后点到线的距离是增大了还是减小了来进行内外的判断。总之CAD它对于实数取位的问题弄得我相当头痛

newbuser · 发表于 2013-12-23 08:27:45

llsheng_73 发表于 2013-12-22 22:43
对于其中的点在不在线内的问题最让我郁闷，由于CAD本身或者是取位的原因，明明在线上的点可能会被判为不在线 ...

这些特殊状况还未遇到过。这个程序还有待完善，程序中无奈用了两次repeat循环，无法使用嵌套foreach，将图框角点坐标表根据图框内的序号坐标排序。

adc · 发表于 2013-12-23 18:58:11

bai2000 · 发表于 2014-4-1 12:34:07

图中有好多图纸，已套好图框（图框为属性块）怎么框选图纸，将图纸按属性快中图纸编号按横向（纵向）间隔排序，这样批量打印后就不用分图整理了

newbuser · 发表于 2014-4-1 14:38:46

bai2000 发表于 2014-4-1 12:34
图中有好多图纸，已套好图框（图框为属性块）怎么框选图纸，将图纸按属性快中图纸编号按横向（纵向）间隔排 ...

你说的是地形图吗？如果是紧挨着的套好图框的地形图估计是不行的，因为相邻的图框重合的部分仍然会被打印出来的。这种需要你分图后，利用scr来完成该项任务。

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

[源码] 利用论坛收集的函数，发个按照编号打印图纸的程序

本帖子中包含更多资源

点评

评分

相关帖子

点评