明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 952|回复: 0

[提问] 论坛的一个批量打印的程序,求修改下!

[复制链接]
发表于 2015-9-1 16:57 | 显示全部楼层 |阅读模式
1明经币
能不能直接选择带KX的外部参照?不用选择

;;; 通用函数 选择集按照给定的组码值进行排序
;;;
;|  参数说明:se  ----要排序的选择集
              dxf ----排序依据的组码号
              int ----如果组码值为一个表,则int指出使用第几个;否则nil
              fuzz----允许偏差;若无为nil
              k    ----t表示从大到小,nil表示从小到大
    返回值:排序后的选择集
    示例:(sort-se ss 10 0   5.0 t  )  表示按照10组码的x坐标值进行排序,允许偏差值为5.0,顺序为从大到小
          (sort-se ss 10 1   3.0 nil)  表示按照10组码的y坐标值进行排序,允许偏差值为3.0,顺序为从小到大
          (sort-se ss 8   nil nil nil)  表示按照8组码值(图层名称)进行排序,顺序为从小到大
|;
(defun sort-se (se dxf int fuzz k / ent index lst newlst newse tmp)
  (setq lst '()
        index 0
  )
  (repeat (sslength se)
    (setq ent (entget (ssname se index))
          tmp (cdr (assoc dxf ent))
    )
    (if (and
          int
          (= (type int) 'int)
          (= (type tmp) 'list)
          (< int (length tmp))
        )
      (setq tmp (nth int tmp))
    )
    (setq lst (cons (list tmp (cdr (assoc 5 ent))) lst))
    (setq index (1+ index))
  )
  (if (and
        fuzz
        (or
          (= (type fuzz) 'int)
          (= (type fuzz) 'real)
        )
        (or
          (= (type tmp) 'int)
          (= (type tmp) 'real)
        )
      )
    (setq newlst (vl-sort lst (function (lambda (e1 e2) (< (+ (car e1) fuzz) (car e2))))))
    (setq newlst (vl-sort lst (function (lambda (e1 e2) (< (car e1) (car e2))))))
  )
  (if k
    (setq newlst (reverse newlst))
  )
  (setq newse (ssadd))
  (foreach tmp newlst
    (setq newse (ssadd (handent (cadr tmp)) newse))
  )
  newse
)

;;;;;;**********************批量打印D2
(setq mspace (vla-get-modelspace
         (vla-get-activedocument (vlax-get-acad-object))
       )
)
(setvar "cmdecho" 0)

(defun c:D2 (/         plotdevice     minp       maxp
       minpoint  maxpoint   tkname     ourset    ilast
       i         my   ent1     orientation
      )
  (print
    "选择标准图框<执行此命令前请在系统的打印设置里选好打印机及打印样式,并应用到布局!!!>"
  )



(SETQ keytk (car (entsel)))
  (while (or (null keytk)
       (/= (cdr (assoc '0 (entget keytk))) "INSERT")
   )
    (SETQ keytk (car (entsel)))
  )
  (setq tkname (cdr (assoc '2 (entget keytk))))
(alert (strcat "是否打印 \" " tkname "\"内的对象?"))
  (setq papersize "")
  (setq plotstyle "")
  (command "ucs" "w")
  (print "选择你将要打印的图框(按顺序点选,不建议框选多个):"
  )

;(ssget "X" '((0 . "INSERT") (66 . 1) (2 . "KX_*"  )));能不能直接选择带KX的外部参照?不用选择

  (SETQ ourset (ssget (list (cons 2 tkname))))
  (while (null ourset)
    (SETQ ourset (ssget (list (cons 2 tkname))))
  )
  (setq ourset (sort-se ourset 10 0 5 t)) ; 表示按照10组码的x坐标值进行排序,允许偏差值为5.0,顺序为从大到小
  (setq ourset (sort-se ourset 10 0 5 nil)) ;图框从左到右
  (setq ourset (sort-se ourset 10 1 3 t))  ;图框从上到下

  (setq ilast (sslength ourset))

  (setq i 0)
  (setq iplot 0)
  (repeat ilast
    (setq my (ssname ourset i))
    (setq ent1 (entget my))
    (if  (= (cdr (assoc '2 ent1)) tkname)
      (progn
  (vla-getboundingbox
    (vlax-ename->vla-object my)
    'minpoint
    'maxpoint
  )
  (setq minp (vlax-safearray->list minpoint))
  (setq maxp (vlax-safearray->list maxpoint))
  (if (> (- (car maxp) (car minp)) (- (cadr maxp) (cadr minp)))
    (setq orientation "landscape")
    (setq orientation "portrait")
  )
  (command "-plot"  "y"     "model"  ""       ""
     "Millimeters"     orientation       "no"     "w"
     minp    maxp     "fit"    "c"       "y"      ""
     "y"    "n"     "n"      "n"       "y"
    )
  (setq iplot (1+ iplot))
      )
    )
    (setq i (1+ i))
  )
  (princ "\n合计页数:")
  (princ iplot)
  (princ)
)

"觉得好,就打赏"
还没有人打赏,支持一下
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 04:39 , Processed in 0.231594 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表