用LISP进行只打印选取实体的程序请教大家...

BDYCAD · 发表于 2003-12-30 18:16:00

近期内写的这样一个小功能增加打印花样. 但在使用在并不是很好. 希望各位大侠提点一下如何更进.
是这么样的,我不知怎么在几个打印框中的图减去选取定打印框的步骤呢?是减少这步不用去选取打印的边框(距形框)
(IF (> (SSLENGTH A) 1)
(SETQ a (ENTSEL "\n發現圖中有多個和打印框屬性相同的框框, 請麻煩選擇打印的邊界框框:")
   AX(CAR a)
   ac(ENTGET AX))
(SETQ AS (SSNAME A 0)
ac (ENTGET AS)
AF (CDR (ASSOC 10 AD))))

我写的程序如下:

;;運行程序事先準備工作: 1. 如沒有程序指定的打印機要增加, 本程序指向的是75686B.PC3
;;功能; 只打印邊界框內程序所選的實體.
;;
(defun c:plotone()
  (setvar "cmdecho" 0)
  (setq os(getvar "osmode" ))
  (setvar "osmode" 0)
  (princ "請選擇要打印的實體:")
  (setq plot (ssget))
  (command ".layer" "f" "L_0" "" "")
  (setq a (ssget "x" '((0 . "LWPOLYLINE") (62 . 6)))); 打印邊界框
  (IF (= a nil)
(progn (ALERT "當前沒有打印邊界框, 要終止......
   \n本訊息由系統自動提示.") (exit)))
  (IF (> (SSLENGTH A) 1)
(SETQ a (ENTSEL "\n發現圖中有多個和打印框屬性相同的框框, 請麻煩選擇打印的邊界框框:")
   AX(CAR a)
   ac(ENTGET AX))
(SETQ AS (SSNAME A 0)
ac (ENTGET AS)
AF (CDR (ASSOC 10 AD))))
  (setq n 0)
  (repeat (length ac)
(setq qend (nth n ac))
(if (= (car qend) 10)
   (setq one (cdr qend))
   (setq n (1+ n))))
  (setq tow (cdr (nth (+ n 4) ac)))
  (setq trhee (cdr (nth (+ n 8) ac)))
  (setq fou (cdr (nth (+ n 12) ac)))
  (command ".erase" a "")
  (setq la (getvar "clayer"))
  (setvar "clayer" "0")
  (command ".erase" "all" "r" plot "")
(command ".layer" "f" "AID" "")
  (command ".layer" "f" "L_0" "")
( command ".plot" "y" "" "7586B.pc3" "ISO A4 (297.00 x 210.00 MM)" "m" "L" "N" "w" one trhee
   "1=1" "0,0" "" "" "" "N" "N" "Y" "");;打印啦
  (command ".undo" 7)
  (entmake ac)
  (setvar "cmdecho" 1) (setvar "osmode" os) (setvar "clayer" la)
  (princ))

顺便符上个DWG文件里面粉红色的距形是代表打印框.

cqnj023 · 发表于 2003-12-31 00:54:00

(CDR (ASSOC 10 AD))))不知AD从何而来？另外(setq a (ssget "x" '((0 . "LWPOLYLINE") (62 . 6))))愚认为不妥，"X"将从整个图形搜索，可能得到符合要求的图框在所选对象之外的情况。
另外，本人也编了一个成批打印的程序，望各位指点，其实，本人是想在程序中动态的调用自定义纸张，以便在一副图中有许多非标准图而又要求按比例出图时自动定义纸张，但不知哪个命令能做到。如图幅大小为600x1400，300x750等大小不一，而每张都不一样，若尺寸与某一标准图纸大小相近则已有办法解决。

(DEFUN C:PDY (/ dylx dylj zwjm wjbh WJBH1 bk bkd tc
ys xx lx dian1 dian2 sfdy ss sslen n
bjx end n2 dylj1 bz sfsz dy dy1 dy2
)
;;;;;;;;;;;;;;;;;;;;;
(defun hbxuanzeji (ss1 ss2 / n wt) ;为了多次围选而定义
(setq n 0)
(if ss1
(progn
(setq sslen (sslength ss1))
(while (< n sslen)
(setq wt (ssname ss1 n))
(ssadd wt ss2)
(setq n (+ n 1))
)
(setq ss2 ss2)
)
)
)
;;;;;;;;;;;;;;;;;;;;;
(setq dylx (getstring "打印到文件(F)或打印到打印机(任意键)<打印机>"))
(setq dylx (strcase dylx t))
(IF (= dylx "f")
(progn
(setq dylj "d:/剖面线/") ;打印文件放置路径，可以另外采用加载对话框的方式选择路径，本人主要是与其他程序配套
(setq zwjm (getstring "输入总文件名<无>:"))
(setq wjbh (getint "输入起始文件编号<1>:"))
(if (= wjbh nil)
(setq wjbh 1)
)
)
)
(setq bk (entsel "\n选择边框类型："))
(while (not bk)
(setq bk (entsel "\n未选中任何对象，请重选择边框类型："))
)
(setq bkd (entget (car bk)))
(foreach dy bkd
(setq bz (car dy))
(if (= bz 8)
(setq tc dy)
)
(if (= bz 62)
(setq ys dy)
)
(if (= bz 70)
(setq xx dy)
)
(if (= bz 0)
(setq lx dy)
)
)
(command "ucs" "w" "")
(setq ss1 (ssadd))
(setq xuanze t)
(while xuanze
(SETQ DIAN1 (GETPOINT "\n选择第一点："))
(setq dian2 (getpoint dian1 "\n选择第二点：")) ;以下选择方式主要是为了控制出图顺序，否则可简化选择式
(if (not dian2)
(setq dian2 dian1)
)
(if (not ys)
(SETQ SS (SSGET "f" (list dian1 dian2) (list lx tc xx)))
(SETQ SS (SSGET "f" (list dian1 dian2) (list lx tc ys xx)))
)
(hbxuanzeji ss ss1)
(setq sslen (sslength ss1))
(princ (strcat "\n共有" (itoa sslen) "个对象需要打印："))
(setq xuanze (getstring "\n继续选择(Y)或结束选择(任意键):<Y>"))
(if (/= xuanze "")
(setq xuanze (strcase xuanze t))
)
(IF (or (= XUANZE "") (= XUANZE "y"))
(SETQ XUANZE NIL)
)
(setq xuanze (NOT XUANZE))
)
(setq sfdy (getstring "\n是(y)否(任意键)打印: <Y>"))
(if (= sfdy "")
(setq sfdy "y")
(setq sfdy (strcase sfdy t))
)
(if (= sfdy "y")
(progn
(setq n 0)
(setq sfsz (getstring "\n是(Y)否(任意键)设置页面及打印机<Y>:"))
(if (= sfsz "")
(setq sfsz "y")
(setq sfsz (strcase sfsz t))
)
(if (= sfsz "y")
(command "pagesetup")
)
(while (< n sslen)
(setq bjx (ssname ss1 n))
(setq end (entget bjx))
(setq n2 1)
(foreach dy end
(setq bz (car dy))
(if (and (= bz 10) (= n2 1))
(setq dy1 (trans (cdr dy) 1 0))
)
(if (and (= bz 10) (= n2 3))
(setq dy2 (trans (cdr dy) 1 0))
)
(if (= bz 10)
(setq n2 (+ n2 +1))
)
)
(setq wjbh1 (itoa (+ n wjbh)))
(while (< (strlen wjbh1) 4)
(setq wjbh1 (strcat "0" wjbh1))
)
(SETQ dylj1 (strcat dylj zwjm WJBH1 ".eps"))
(if (= dylx "p")
(command "-plot" "y" "" "" "" "m" ""
"" "w" dy1 dy2 "" "" "y" ""
"y" "n" "n" "n" "y"
)
(command "-plot" "y" "" "" "" "m" ""
"" "w" dy1 dy2 "" "" "y" ""
"y" "n" "y" DYLJ1 "n" "y"
)
)
(setq n (+ n 1))
)
)
)
)

(DEFUN C:PDY (/        dylx  dylj  zwjm  wjbh        WJBH1 bk    bkd          tc 
                  ys        xx    lx    dian1 dian2        sfdy  ss    sslen n 
                  bjx        end   n2    dylj1 bz        sfsz dy    dy1   dy2 
                 ) 
;;;;;;;;;;;;;;;;;;;;; 
  (defun hbxuanzeji (ss1 ss2 / n wt) ;为了多次围选而定义 
    (setq n 0) 
    (if ss1 
      (progn 
    (setq sslen (sslength ss1)) 
    (while (< n sslen) 
      (setq wt (ssname ss1 n)) 
      (ssadd wt ss2) 
      (setq n (+ n 1)) 
    ) 
    (setq ss2 ss2) 
    ) 
  ) 
    ) 
;;;;;;;;;;;;;;;;;;;;;   
  (setq dylx (getstring "打印到文件(F)或打印到打印机(任意键)<打印机>")) 
      (setq dylx (strcase dylx t)) 
      (IF (= dylx "f") 
        (progn 
          (setq dylj "d:/剖面线/")                ;打印文件放置路径，可以另外采用加载对话框的方式选择路径，本人主要是与其他程序配套 
          (setq zwjm (getstring "输入总文件名<无>:")) 
          (setq wjbh (getint "输入起始文件编号<1>:")) 
          (if (= wjbh nil) 
            (setq wjbh 1) 
          ) 
        ) 
      ) 
      (setq bk (entsel "\n选择边框类型：")) 
      (while (not bk) 
        (setq bk (entsel "\n未选中任何对象，请重选择边框类型：")) 
      ) 
      (setq bkd (entget (car bk))) 
      (foreach dy bkd 
        (setq bz (car dy)) 
        (if (= bz 8) 
          (setq tc dy) 
        ) 
        (if (= bz 62) 
          (setq ys dy) 
        ) 
        (if (= bz 70) 
          (setq xx dy) 
        ) 
        (if (= bz 0) 
          (setq lx dy) 
        ) 
      ) 
      (command "ucs" "w" "") 
      (setq ss1 (ssadd)) 
      (setq xuanze t) 
      (while xuanze 
 
        (SETQ DIAN1 (GETPOINT "\n选择第一点：")) 
        (setq dian2 (getpoint dian1 "\n选择第二点：")) ;以下选择方式主要是为了控制出图顺序，否则可简化选择式 
        (if (not dian2) 
          (setq dian2 dian1) 
          ) 
        (if (not ys) 
          (SETQ SS (SSGET "f" (list dian1 dian2) (list lx tc xx))) 
          (SETQ SS (SSGET "f" (list dian1 dian2) (list lx tc ys xx))) 
        ) 
        (hbxuanzeji ss ss1) 
      (setq sslen (sslength ss1)) 
      (princ (strcat "\n共有" (itoa sslen) "个对象需要打印：")) 
        (setq xuanze (getstring "\n继续选择(Y)或结束选择(任意键):<Y>")) 
        (if (/= xuanze "") 
          (setq xuanze (strcase xuanze t)) 
        ) 
        (IF (or (= XUANZE "") (= XUANZE "y")) 
          (SETQ XUANZE NIL) 
        ) 
        (setq xuanze (NOT XUANZE)) 
      ) 
      (setq sfdy (getstring "\n是(y)否(任意键)打印: <Y>")) 
 
 
      (if (= sfdy "") 
        (setq sfdy "y") 
        (setq sfdy (strcase sfdy t)) 
      ) 
      (if (= sfdy "y") 
        (progn 
          (setq n 0) 
          (setq sfsz (getstring "\n是(Y)否(任意键)设置页面及打印机<Y>:")) 
            (if (= sfsz "") 
        (setq sfsz "y") 
        (setq sfsz (strcase sfsz t)) 
      ) 
            (if (= sfsz "y") 
              (command "pagesetup") 
              ) 
           
          (while (< n sslen) 
            (setq bjx (ssname ss1 n)) 
            (setq end (entget bjx)) 
            (setq n2 1) 
            (foreach dy        end 
              (setq bz (car dy)) 
              (if (and (= bz 10) (= n2 1)) 
                (setq dy1 (trans (cdr dy) 1 0)) 
              ) 
              (if (and (= bz 10) (= n2 3)) 
                (setq dy2 (trans (cdr dy) 1 0)) 
              ) 
              (if (= bz 10) 
                (setq n2 (+ n2 +1)) 
              ) 
            ) 
             
            (setq wjbh1 (itoa (+ n wjbh))) 
            (while (< (strlen wjbh1) 4) 
              (setq wjbh1 (strcat "0" wjbh1)) 
            ) 
 
 
            (SETQ dylj1 (strcat dylj zwjm WJBH1 ".eps")) 
            (if        (= dylx "p") 
              (command "-plot"           "y"         ""    ""    ""           "m"         "" 
                       ""    "w"   dy1         dy2   ""    ""           "y"         "" 
                       "y"   "n"   "n"         "n"   "y" 
                      ) 
              (command "-plot"           "y"         ""    ""    ""           "m"         "" 
                       ""    "w"   dy1         dy2   ""    ""           "y"         "" 
                       "y"   "n"   "y"         DYLJ1 "n"   "y" 
                      ) 
            ) 
 
            (setq n (+ n 1)) 
          ) 
        ) 
      ) 
    )

龙龙仔 · 发表于 2004-1-2 12:38:00

BDYCAD发表于2003-12-30 18:16:00用LISP进行只打印选取实体的程序请教大家...
近期内写的这样一个小功能增加打印花样. 但在使用在并不是很好. 希望各位大侠提点一下如何更进.

;;Sorry!看不懂你要甚麼??
;;展示所有實體
(defun C:PLOTONE (/ OS PLOT N PT ONE THREE)
(vl-load-com)
(defun GETBOUNDINGBOX (ENT / LL UR)
(vla-getboundingbox (vlax-ename->vla-object ENT) 'LL 'UR)
(mapcar 'vlax-safearray->list (list LL UR))
)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
;;(princ "請選擇要打印的實體:")
(setq PLOT (ssget "x"))
(setq N 0)
(repeat (sslength PLOT)
(setq PT (GETBOUNDINGBOX (ssname PLOT N)))
(setq ONE (car PT)
THREE (last PT)
)
(command "_.zoom" "w" ONE THREE)
(command "_.delay" 1000)
(setq N (1+ N))
)
(command "_.zoom" "e")
(princ)
)

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

用LISP进行只打印选取实体的程序请教大家...

本帖子中包含更多资源