[求助]：程序尚差条件,该如何处理?

啵浪鼓

(defun c:pr2 (/ pt1 pt2)
(setvar "cmdecho" 0)
(setvar "osmode" 39)
(setq pt1(getpoint "选择一个角点"))
(setq pt2(getcorner pt1 "\n选择另一角点"))
(setq pt1x (nth 1pt1) pt1y (nth 2 pt1) pt2x (nth 1pt2) pt2y (nth 2 pt2))
(if
(if (> pt1x pt3x) ;;就已知的方法试写了几种,但如果出现负数的状况下就不成立了,不知咋写了...
(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "垂直打印OK"))
(command "-plot" "y" "model" "HP5100" "A4" "m" "l" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "横向打印OK"))
(princ)
)


上面程序是对角打印的程序,比如A4纸大小为300*200框选,0零设定在(setq pt1(getpoint ))此点上,分析选择pt2时所得的X柚大于Y柚时,得到(princ "垂直打印OK")),当X横小于Y柚时得到(princ "横向打印OK"))

当框选从左下角到右上角时,pt1的X为0,Y为0,pt2的X为300,Y为200,
得到> X Y 执行打印(princ "横向打印OK"))
如果框选从右上角到左下角时,此时pt1的X为0,Y为0,而pt2的X为-300,Y为-200,此时< X Y,执行打印(princ "垂直打印OK")),打印反了,这该如何处理啊?

上面的问题简单而论,当正数时,300大于200,打印OK,
当负数时,-300小于-200,上面的打印程序就打反了~

狂刀

(if (> pt1x pt3x) ?? pt3x是什么?

(if (> (abs(- pt1x pt2x)) (abs(- pt1y pt2y))).....

啵浪鼓

(defun c:pr2 (/ pt1 pt2)
(setvar "cmdecho" 0)
(setvar "osmode" 39)
(setq pt1(getpoint "选择一个角点"))
(setq pt2(getcorner pt1 "\n选择另一角点"))
(setq pt1x (nth 1 pt1) pt1y (nth 2 pt1) pt2x (nth 1 pt2) pt2y (nth 2 pt2))
(if
(if (> (abs(- pt1x pt2x)) (abs(- pt1y pt2y)))
(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "垂直打印OK"))
(command "-plot" "y" "model" "HP5100" "A4" "m" "l" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "横向打印OK"))
(princ)
)

改成上面的程序后,怎么全是(princ "横向打印OK"),这是pt1 x=300,y=200
如果是x=200,y=300,就应该是垂直打印,可程序依然是(princ "横向打印OK")

麻烦狂刀再帮我改改,不胜感激中...

狂刀

你犯了大错,
.nth从0起算.!!!
另if语句写的乱,
[php]
(defun c:pr2 (/ pt1 pt2 pt1x pt1y pt2x pt2y)
  (setvar "cmdecho" 0)
  (setvar "osmode" 39)
  (setq pt1 (getpoint "选择一个角点"))
  (setq pt2 (getcorner pt1 "\n选择另一角点"))
  (setq        pt1x (nth 0 pt1)
        pt1y (nth 1 pt1)
        pt2x (nth 0 pt2)
        pt2y (nth 1 pt2)
  )
    (if        (< (abs (- pt1x pt2x)) (abs (- pt1y pt2y)))
      ;;(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
      (princ "垂直打印OK")
     ;;(command "-plot" "y" "model" "HP5100" "A4" "m" "l" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
      (princ "横向打印OK")
    )
  (princ)
)[/php]

舟自横

狂刀兄说的没错,李兄你怎么这么糊涂呢,
看在兄弟的分上给一个比较实用的快速
列印的程序给你是我用VB编的,好看又好用
不是盖的..呵呵..你可以自己写LISP去调用
它(STARTAPP (FINDFIE "CADPLOT.EXE"))
不过你先要把它放在你的支持路径下

啵浪鼓

太棒了,改得真好,再帮我看看全打印程序:

(defun c:prn( / ok cmde osmo cmdd s i na3 na4 na5 s1 p1 scl p2 notes fi s3 s4 sb)
              (princ "欢迎进入打印系统")
              (setvar "osmode" 0)
              (setvar "cmdecho" 0)
              (setvar "cmddia" 0)
              (setvar "filedia" 1)
              (command "ucsicon" "n")
              (command "ucsicon" "on")
              (command "ucs" "world")
              (initget " 2 3 4 ")
              (setq ok(getkword "\n[对角打印按'2'/打印A3按'3'/打印A4按'4']<全部请按回车或空

格键>  "))
              (if (= "2" ok)(progn(setq s nil)(pr2)))
              (if (= "3" ok)(progn(setq s nil)(pr3)))
              (if (= "4" ok)
                 (setq s(ssget '(
                                  (0 . "INSERT")
                                  (-4 . "<or")
                                  (2 . "A3")(2 . "A4")(2 . "BOM1")(2 . "bomx")
                                  (-4 . "or>"))))
                 (SETQ s(SSGET "X"'(
                                     (0 . "INSERT")
                                     (-4 . "<or")
                                     (2 . "A3")(2 . "A4")(2 . "BOM1")(2 . "bomx")
                                     (-4 . "or>"))))
              )
              (command "zoom" "e" "ucs" "world")
              (setq s3 (ssadd) s33 (ssadd) s333 (ssadd) s4 (ssadd) sb (ssadd) i 0)
              (while (< i (sslength s))               
                (if (and(= "A3" (cdr(assoc 2 (entget (ssname s i)))))
                        (= 0 (cdr(assoc 50 (entget (ssname s i))))))
                  (ssadd (ssname s i) s3))                               
                (if (and(= "A3" (cdr(assoc 2 (entget (ssname s i)))))
                        (< 4.7 (cdr(assoc 50 (entget (ssname s i)))))
                        (> 4.8 (cdr(assoc 50 (entget (ssname s i))))))
                  (ssadd (ssname s i) s33))                               
                (if (and(= "A3" (cdr(assoc 2 (entget (ssname s i)))))
                        (< 1.57 (cdr(assoc 50 (entget (ssname s i)))))
                        (> 1.6 (cdr(assoc 50 (entget (ssname s i))))))
                  (ssadd (ssname s i) s333))
                (if(= "A4" (cdr(assoc 2 (entget (ssname s i)))))
                  (ssadd (ssname s i) s4))
                (if(OR(= "BOM1" (cdr(assoc 2 (entget (ssname s i)))))(= "bomx" (cdr(assoc 2

(entget (ssname s i))))))
                  (ssadd (ssname s i) sb))
                (setq i (+ i 1)))

              (setq i 0 na3 0)
              (while (< i (sslength s3))
                     (setq s1(ssname s3 i))                     
                     (setq na3(+ 1 na3))
                     (setq p1(cdr(assoc 10 (entget s1))))
                     (setq scl(cdr(assoc 41 (entget s1))))
                     (setq p2(list (+(* scl 289)(car p1))(+(* scl 200)(cadr p1))))
(command "-plot" "y" "model" "HP5555" "A4" "m" "l" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb"
"y" "n" "n" "n" "y")
               (setq i(+ i 1)))

              (setq i 0 na33 0)
              (while (< i (sslength s33))
                     (setq s11(ssname s33 i))                     
                     (setq na33(+ 1 na33))
                     (setq p1(cdr(assoc 10 (entget s11))))
                     (setq scl(-(cdr(assoc 41 (entget s11)))))
                     (setq p2(list (-(-(* scl 200))(-(car p1)))(+(* scl 289)(cadr p1))))
(command "-plot" "y" "model" "HP5555" "A4" "m" "p" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb"
"y" "n" "n" "n" "y")
               (setq i(+ i 1)))

              (setq i 0 na333 0)
              (while (< i (sslength s333))
                     (setq s111(ssname s333 i))                     
                     (setq na333(+ 1 na333))
                     (setq p1(cdr(assoc 10 (entget s111))))
                     (setq scl(-(cdr(assoc 41 (entget s111)))))
                     (setq p2(list (+(* scl 200)(car p1))(-(-(* scl 289)(cadr p1)))))
(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb"
"y" "n" "n" "n" "y")
               (setq i(+ i 1)))
              
              (setq i 0 na4 0)
              (while (< i (sslength s4))
                     (setq s1(ssname s4 i))
                     (setq na4(+ 1 na4))
                     (setq p1(cdr(assoc 10 (entget s1))))
                     (setq scl(cdr(assoc 41 (entget s1))))
                     (setq p2(list (+(* scl 201)(car p1))(+(* scl 289)(cadr p1))))
(command "-plot" "y" "model" "HP5100" "A4" "m" "L" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb"

"y" "n" "n" "n" "y")
                     (setq i(+ i 1)))
                (setq i 0 na5 0)
              (while (< i (sslength sb))
                     (setq s1(ssname sb i))
                     (setq na5(+ 1 na5))
                     (setq p1(cdr(assoc 10 (entget s1))))
                     (setq scl(cdr(assoc 41 (entget s1))))
                     (setq p2(list (+(* scl 201)(car p1))(+(* scl 289)(cadr p1))))
(command "-plot" "y" "model" "HP5100" "A4" "m" "L" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb"

"y" "n" "n" "n" "y")
                     (setq i(+ i 1)))

(rtos na3 2 0)"张,'bom'= " (rtos na5 2 0)" 张!!!!!"))
              (setq notes(strcat "打印完毕! 打印 'A4-0' = " (rtos na3 2 0) " 张, 'A4-90'= "

(rtos na33 2 0)"张,'A4-180'= " (rtos na333 2 0)" 张!!!!!"))
              (print notes)
              (setvar "osmode" 39)
              (setvar "cmddia" 1)
              (setvar "filedia" 1)
(princ)
)


;(defun *error* (msg)
;  (princ "error: ")
;  (princ msg)
;  (print "出错啦,没有找到标准图框或是中断打印!!!")
;  (princ)
;              (setvar "osmode" 39)
;              (setvar "cmddia" 1)
;              (setvar "filedia" 1)
;)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pr3(/ s a n m j kk lname li p0 p1 p2 x y xx yy notess)
             (princ "\n选择需打印的A3的图纸!")
             (setq s(ssget '(
                            (0 . "INSERT")
                            (-4 . "<or")
                            (2 . "A3")
                            (-4 . "or>"))))
        (setq i 0)(setq qty 0)
        (while (< i (sslength s))
            (setq li (entget (ssname s i)))
            (setq qty (+ qty 1))
            (setq p1  (assoc '10 li))   
            (setq p0 ( list (nth 1 p1) (nth 2 p1)))
            (setq xx (cdr (assoc '41 li)))
            (setq yy (cdr (assoc '42 li)))
            (setq x (* xx 289))
            (setq y (* yy 200))
            (setq p1 (polar p0 (/ pi 2) y))
            (setq p2 (polar p0 0 x))
(command "-plot" "y" "model" "HP5100" "A3" "m" "L" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb"

"y" "n" "n" "n" "y")
    (setq i (+ i 1 )))
    (setq notess(Strcat "打印完毕! 打印 'A3' = " (rtos qty 2 0) " 张!!!!!"))
    (print notess)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pr2 (/ pt1 pt2 pt1x pt1y pt2x pt2y)
  (setvar "cmdecho" 0)
  (setvar "osmode" 39)
  (setq pt1 (getpoint "选择一个角点"))
  (setq pt2 (getcorner pt1 "\n选择另一角点"))
  (setq    pt1x (nth 0 pt1)
    pt1y (nth 1 pt1)
    pt2x (nth 0 pt2)
    pt2y (nth 1 pt2)
  )
    (if    (< (abs (- pt1x pt2x)) (abs (- pt1y pt2y)))
      ;;(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y"

"acad.ctb" "y" "n" "n" "n" "y")
      (princ "垂直打印OK")
     ;;(command "-plot" "y" "model" "HP5100" "A4" "m" "l" "y" "w" pt1 pt2 "fit" "c" "y"

"acad.ctb" "y" "n" "n" "n" "y")
      (princ "横向打印OK")
    )
  (princ)
)

下面程序问题出在下面语句上,程序的问题在于，如果选择了3，也就是执行pr3的程序，可执行完pr3后会再回到主程序再执行打印A4所有图纸的命令一次，变成重复打印了。没办法，在pr3的结尾我加写了(exit)当打印完A3因退出程序而不再执行主程序打印所有A4图纸了，此方法太可笑了。。。选2是执行pr2执行对角打印，可打印完也出现; error: bad argument type: lselsetp nil，不然也是要回主程序也打印所有A4图纸，也变成重复打印了!
程序如果单独打印,是没有问题的,我想应该是下面的语句设置不适当,以致于打印了子程序又回主程序重复执行了结果
(if (= "2" ok)(progn(setq s nil)(pr2)))
(if (= "3" ok)(progn(setq s nil)(pr3)))
(if (= "4" ok)

xyp1964

楼上的程序太长，布局又没章法，看起来有点累。
提供一个“PDF”格式打印的程序供参考：
[php]
(defun c:pdf (/ pt1 pt2 ro)
  ;(cmdla0)
  (setvar "ORTHOMODE" 0)
  (prompt "\n\t生成A2幅面PDF黑白文件。")
  (pt-zw)
  (HVtest)
  (command
    "-plot"
    "y"
    "model"
    "Adobe PDF.pc3"
    "A2"
    "M"
    (if        (= ro "Y") "p" "L")
    "N"
    "w"
    pt1
    pt2
    "fit"
    "c"
    "y"
    "acad-PDF-黑白.ctb"
    "y"
    "As displayed"
    "n"
    "y"
    "y"
  )
  ;(cmdla1)
)
;;;确定打印范围并充满窗口，便于确定打印文件名称
(defun pt-zw ()
  (setvar "OSMODE" 1)
  (setq        pt1 (getpoint "\n第1角点 : ")
        pt2 (getcorner pt1 "\n对角点 : ")
  )
  (command "zoom" "w" pt1 pt2)
)
;;;判断打印方向：横向或竖向
(defun HVtest ()
  (if (< (abs (- (car pt1) (car pt2)))
         (abs (- (cadr pt1) (cadr pt2)))
      )
    (setq ro "Y")
    (setq ro "N")
  )
)
[/php]

它山之石

还可以看看这个程序：
http://www.xdcad.net/forum/showthread.php?s=&threadid=336752

另舟自横的程序怎么是这样的界面

舟自横

(defun c:qe(/ fp ena blockname searchblock indexname nextename allpointlist
                namedata pmax pmin paper rotate ssblock j blocknu scale inserpoint
                fp ff data datalist plotname plotpenc a3paper a3rotate a4paper
                a4rotate);;;;ap-extmax;;;ap-extmin;;;ap-api函數
  (command "ucs" "w")
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (if (= (findfile"c:\\autocadprintset.dat") nil)
          (progn (alert "列印尚未設置﹐請設置后再次執行此命令!")
          (startapp (FINDFILE "cadplot.exe"))
            (exit))
    )
  (setq fp (findfile"c:\\autocadprintset.dat"))
  (setq ff (open fp "r"))
  (setq datalist '())
  (setq data (read-line ff))
  (while data
    (setq datalist (cons data  datalist))
    (setq data (read-line ff)))
  (close ff)
  (setq datalist (reverse datalist))
  (setq plotname (nth 0 datalist)
        plotpenc (nth 1 datalist)
        a3paper (nth 2 datalist)
        a3rotate (nth 4 datalist)
        a4paper (nth 5 datalist)
        a4rotate (nth 7 datalist))
  (vl-load-com)
  (while (not(setq ena (car(entsel "\n請選擇一個需要列印的圖框塊做為參考:"))))
    (setq ena (car(entsel "\n請選擇一個需要列印的圖框塊做為參考:"))))
  (setq blockname (cdr(assoc 2 (entget ena))))
  (setq searchblock (tblsearch "block" blockname))
  (setq indexname (cdr (assoc -2 searchblock)))
  (setq nextename indexname)
  (setq allpointlist '())
  (while nextename
    (setq namedata (entget nextename))
    (if (or (= (cdr(assoc 0 namedata)) "LINE")(= (cdr(assoc 0 namedata)) "POLYLINE")
            (= (cdr(assoc 0 namedata)) "LWPOLYLINE"))
       (foreach item namedata (if (or (= (car item) 10) (= (car item) 11))
                                        (setq allpointlist (cons (AP-2D->3D (cdr item)) allpointlist))
                                        )
                 )
      )
    (setq nextename (entnext nextename))
    )
  (setq pmax (ap-extmax allpointlist)
        pmin (ap-extmin allpointlist))
  (if (> (- (car pmax) (car pmin))(- (caDr pmax) (caDr pmin)))
    (setq paper a3paper rotate a3rotate) (setq paper a4paper rotate a4rotate))
  (prompt (strcat"\n圖塊已參考" blockname "請選擇需要列印的" blockname "圖框:"))
  (setq ssblock (ssget (list (cons 2 blockname))))
  (setq j 0)
  (repeat (sslength ssblock)
    (setq blocknu (ssname ssblock j))
    (setq scale (cdr(assoc 41 (entget blocknu))))
    (setq inserpoint (cdr(assoc 10 (entget blocknu))))
    (command "ucs" "o" inserpoint)
;;;    (command "zoom" "w" (ap-vector-scale scale pmax);(trans (ap-vector-scale scale pmax) 0 1)
;;;                       (ap-vector-scale scale pmin));(trans (ap-vector-scale scale pmin) 0 1))
    (command "-plot" "y" "" plotname paper "I" rotate "N" "W" (ap-vector-scale scale pmax)
             (ap-vector-scale scale pmin) "F" "0,0" "Y" plotpenc "Y" "N" "N" "N" "Y")
    (setq j (1+ j))
    ;(command "delay" 1000)
    (command "ucs" "w")
    )
;;;  (command "zoom" "e")
  (prin1)
  )
你想要LISP的就給你一个,是和我上面哪个VB联系一起的,
也可以不用那个VB单独用的你自己可以将它修改一下,
要用到几个AP-API函数顺便附上一起加载就可以了!

楼上的长老不好意思我的是繁体版的,如果你需要的话我
可以帮你转一下!呵呵

啵浪鼓

(defun c:prn( / )
(princ "欢迎进入打印系统")
(command "ucs" "world")
(initget " 2 3 4 ")
(setq ok(getkword "\n[对角打印按'2'/打印A3按'3'/打印A4按'4']<全部请按回车或空格键> "))
  (if (= "2" ok)(progn(setq s nil)(pr2)))
  (if (= "3" ok)(progn(setq s nil)(pr3)))
  (if (= "4" ok)
    (setq s(ssget '(
                                  (0 . "INSERT")
                                  (-4 . "<or")
                                  (2 . "A3")(2 . "A4")(2 . "BOM1")(2 . "bomx")
                                  (-4 . "or>"))))
     (SETQ s(SSGET "X"'(
                                  (0 . "INSERT")
                                  (-4 . "<or")
                                  (2 . "A3")(2 . "A4")(2 . "BOM1")(2 . "bomx")
                                  (-4 . "or>"))))
  )

(command "zoom" "e" "ucs" "world")
(setq s3 (ssadd)  i 0)
(while (< i (sslength s))
(if (and(= "A3" (cdr(assoc 2 (entget (ssname s i)))))
(= 0 (cdr(assoc 50 (entget (ssname s i))))))
(ssadd (ssname s i) s3))
(setq i (+ i 1)))

(setq i 0 na3 0)
(while (< i (sslength s3))
(setq s1(ssname s3 i))
(setq na3(+ 1 na3))
(setq p1(cdr(assoc 10 (entget s1))))
(setq scl(cdr(assoc 41 (entget s1))))
(setq p2(list (+(* scl 289)(car p1))(+(* scl 200)(cadr p1))))
(command "-plot" "y" "model" "HP5555" "A4" "m" "l" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb"
"y" "n" "n" "n" "y")
(setq i(+ i 1)))

(setq notes(strcat "打印完毕! 打印 'A4-' = " (rtos na3 2 0) " !!!!!"))
(print notes)
(setvar "osmode" 39)
(setvar "cmddia" 1)
(setvar "filedia" 1)
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pr3(/)
(princ "\n选择需打印的A3的图纸!")
             (setq s(ssget '(
                            (0 . "INSERT")
                            (-4 . "<or")
                            (2 . "A3")
                            (-4 . "or>"))))
(setq i 0)(setq qty 0)
(while (< i (sslength s))
(setq li (entget (ssname s i)))
(setq qty (+ qty 1))
(setq p1 (assoc '10 li))
(setq p0 ( list (nth 1 p1) (nth 2 p1)))
(setq xx (cdr (assoc '41 li)))
(setq yy (cdr (assoc '42 li)))
(setq x (* xx 289))
(setq y (* yy 200))
(setq p1 (polar p0 (/ pi 2) y))
(setq p2 (polar p0 0 x))
(command "-plot" "y" "model" "HP5100" "A3" "m" "L" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb"
"y" "n" "n" "n" "y")
(setq i (+ i 1 )))
(setq notess(Strcat "打印完毕! 打印 'A3' = " (rtos qty 2 0) " 张!!!!!"))
(print notess)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pr2 (/ pt1 pt2 pt1x pt1y pt2x pt2y)
(setvar "cmdecho" 0)
(setvar "osmode" 39)
(setq pt1 (getpoint "选择一个角点"))
(setq pt2 (getcorner pt1 "\n选择另一角点"))
(setq pt1x (nth 0 pt1)
      pt1y (nth 1 pt1)
      pt2x (nth 0 pt2)
      pt2y (nth 1 pt2)
)
(if (< (abs (- pt1x pt2x)) (abs (- pt1y pt2y)))
;;(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y"

"acad.ctb" "y" "n" "n" "n" "y")
(princ "垂直打印OK")
;;(command "-plot" "y" "model" "HP5100" "A4" "m" "l" "y" "w" pt1 pt2 "fit" "c" "y"

"acad.ctb" "y" "n" "n" "n" "y")
(princ "横向打印OK")
)
(princ)
)

程序改短了,上面总共为1个主程序2个子程序,如果将之分开打印不会有问题,我现在将这3个程序拼成一个程序,我想应该是下面的语句设置不适当,以致于打印了子程序又回主程序重复执行了结果
(if (= "2" ok)(progn(setq s nil)(pr2)))
(if (= "3" ok)(progn(setq s nil)(pr3)))
(if (= "4" ok)

xyp1964

最初由 啵浪鼓 发布
[B](defun c:prn( / )
(princ "欢迎进入打印系统")
(command "ucs" "world")
(initget " 2 3 4 ")
(setq ok(getkword "\n[对角打印按'2'/打印A3按'3'/打印A4按'4']<全部请按回车或空格键> "))
  (if (= "2" ok)(pr... [/B]

程序错误太多，左右括号不闭合！
最好用Visual LISP编辑器测试。
因打印机、图块名称不同，本人无法测试！
[php]
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")

(defun c:prn ()
  (cmdla0)
  (princ "\n欢迎进入打印系统!")
  (command "ucs" "")
  (setq ok (ukword 1 "2 3 4" "\n2-对角打印/3-打印A3/4-全部打印A4" ok))
  (cond
    ((= "2" ok) (setq s nil) (pr2))
    ((= "3" ok) (setq s nil) (pr3))
    ((= "4" ok) (setq s nil) (pr4))
  )
  (cmdla1)
)

(defun pr2 ()
  (setvar "osmode" 39)
  (setq        pt1 (getpoint "选择一个角点")
        pt2 (getcorner pt1 "\n选择另一角点")
  )
  (HVtest pt1 pt2)
  (command "-plot" "y" "model" "HP5100" "A4" "m"
           (if (= ro "Y") "p" "L" ) "y" "w"
           pt1 pt2 "fit" "c" "y" "acad.ctb"
           "y" "n" "n" "n" "y")
)

(defun pr3 ()
  (princ "\n选择需打印的A3的图纸!")
  (setq        ss  (ssget '((0 . "INSERT") (2 . "A3")))
        i   -1
        qty 0
  )
  (while (setq s (ssname ss (setq i (1+ i))))
    (setq li  (entget s)
          qty (+ qty 1)
          p1  (assoc '10 li)
          p0  (list (nth 1 p1) (nth 2 p1))
          xx  (cdr (assoc '41 li))
          yy  (cdr (assoc '42 li))
          x   (* xx 289)
          y   (* yy 200)
          p1  (polar p0 (/ pi 2) y)
          p2  (polar p0 0 x)
    )
    (command "-plot" "y" "model" "HP5100" "A3" "m" "L" "y" "w"
           p1 p2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
  )
  (setq notess (Strcat "打印完毕! 打印 A3 = " (rtos qty 2 0) " 张!"))
  (print notess)
  (princ)
)

(defun pr4 ()
  (setq ss (ssget "X" '((0 . "INSERT") (2 . "A3,A4,BOM1,bomx"))))
  (command "zoom" "e")
  (setq        s3 (ssadd)
        i  -1
  )
  (while (setq s (ssname ss (setq i (1+ i))))
    (if        (and (= "A3" (cdr (assoc 2 (entget s))))
             (= 0 (cdr (assoc 50 (entget s))))
        )
      (ssadd s s3)
    )
  )
  (setq        i -1
        na3 0
  )
  (while (setq s1 (ssname s3 (setq i (1+ i))))
    (setq na3 (+ 1 na3)
          p1  (cdr (assoc 10 (entget s1)))
          scl (cdr (assoc 41 (entget s1)))
          p2  (list (+ (* scl 289) (car p1)) (+ (* scl 200) (cadr p1)))
    )
    (command "-plot" "y" "model" "HP5555" "A4"  "m" "l" "y"  "w"
          p1 p2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
  )
  (setq notes (strcat "打印完毕! 打印 'A4-' = " (rtos na3 2 0) " !"))
  (print notes)
                                        ;(setvar "osmode" 39)
                                        ;(setvar "cmddia" 1)
                                        ;(setvar "filedia" 1)
)

(defun HVtest (pt1 pt2)
  (if (< (abs (- (car pt1) (car pt2)))
         (abs (- (cadr pt1) (cadr pt2)))
      )
    (setq ro "Y")
    (setq ro "N")
  )
)

(princ "命令 : prn")
[/php]

啵浪鼓

好像贴上来的文章再考贝,双引号的部份会出错,我现在将DWG图档及程序贴上,你帮我测一下好吗?

我的程序主要是这样:按2执行对角打印(定2点打印),按3执行打印A3(选择A3块),按4是执行A4打印(选择A3块),按空格或回车是图档内所有A3块按A4纸全部出图,不用带选择的~
(setq ok(getkword "\n[对角打印按'2'/打印A3按'3'/打印A4按'4']<全部请按回车或空格键> "))
(if (= "2" ok)(progn(setq s nil)(pr2)))
(if (= "3" ok)(progn(setq s nil)(pr3)))
(if (= "4" ok)
(setq s(ssget '(
(0 . "INSERT")
(-4 . " (2 . "A3")(2 . "A4")(2 . "BOM1")(2 . "bomx")
(-4 . "or>"))))
(SETQ s(SSGET "X"'(
(0 . "INSERT")
(-4 . " (2 . "A3")(2 . "A4")(2 . "BOM1")(2 . "bomx")
(-4 . "or>"))))
)

啵浪鼓

怎么不能一次上传2个文件?

而且不能上传DWG文件,你将附件后缀名改为dwg才行

xyp1964

自己测试，有何问题？

啵浪鼓

总共为1个主程序(打印A4部份为主)2个子程序(pr3和pr2为子程序),如果将之分开打印不会有问题,将这3个程序拼成一个程序,以致于打印了子程序又回主程序重复执行了结果

在打印完(pr2)程序结尾加写了一句(exit)才能终止再回主程序重复打印,但这样显示下面提示感觉不爽:

Command: (exit)
; error: quit / exit abort