[求助]：关于记忆上次框选重新加入其它框选实施打印

啵浪鼓

(defun pr1 (/ pt1 pt2 pt1x pt1y pt2x pt2y)
  (setvar "cmdecho" 0)
  (setvar "osmode" 39)
  (time)
  (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)))
      (progn
        (command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
        (princ "垂直打印?OK"))
      (progn
        (command "-plot" "y" "model" "HP5100" "A4" "m" "L" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
      (princ "横向打印?OK")
    ))
(exit)
  (princ)
)

上面为对角打印程序一张图面，我想打印好几张图纸而不用等待网络打印机的回应（因为网络打印机老有几秒的等待时间），设置好pt1和pt2时跳出对话框提示：
1，继续选择  2，取消上次选择 3，OK
继续选择为记住上次框选位置，再加入另一组框选
取消上次选择，重新框选pt1 pt2的位置
按ok键开始运行用户输入的几次框选同时打印

不要建block的形式，因为客供图纸一般就几张，如果建block什么的，不实用，请求帮忙~·

舟自横

呵呵我来说两句:
这个问题嘛是一个简单的问题啦......(开场白)
你可以先不忙的用COMMAND 命令嘛将你所
点选到的点用列表先"储存"起来在一起用循环
+COMMAND "PLOT"不就可以达到效果了吗?
这样的程序不难吧?看吧给你写一下
(defun c:selectpointtoplot(/ pt1 pt2 ptlist delt key)
  (setvar "cmdecho" 0)
  (setvar "osmode" 39)
  (setq ptlist NIL)
  (setq pt1 (getpoint "\n請選擇一角點:"))
  (setq pt2 (getcorner pt1 "\n選擇另一角點:"))
  (setq ptlist (cons (list pt1 pt2) ptlist))
(setq delt t)
  (while delt
    (initget "1 2 3")
    (setq key (getkword "\n繼續選點(1),取消上次(2),打印出圖(3),(1?):"))
    (if (= key nil) (setq key "1"))
    (cond ((= key "1") (progn                               (setq pt1 (getpoint "請選擇一角點:"))
                              (setq pt2 (getcorner pt1 "\n選擇另一角點:"))
                              (setq delt t)
                         (setq ptlist (cons (list pt1 pt2) ptlist))
))
          ((= key "2") (if (= nil ptlist) (progn (alert"\n記憶中已無打印點!") (setq delt NIL))
(PROGN(setq ptlist (vl-remove (last ptlist) ptlist))
                              (setq delt t)
                         )))
          ((= key "3") (setq delt nil))
          )
    )
(SETVAR "OSMODE" 0)
  (if (= nil ptlist) (exit))
    (foreach item ptlist (pr1 (car item) (cadr item)))
    )
  (prin1)
  )


(defun pr1 (pt1 pt2 / pt1x pt1y pt2x pt2y)
(time)
(setq pt1x (nth 0 pt1)
pt1y (nth 1 pt1)
pt2x (nth 0 pt2)
pt2y (nth 1 pt2)
)
(if (< (abs (- pt1x pt2x)) (abs (- pt1y pt2y)))
(progn
(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "垂直打印OK"))
(progn
(command "-plot" "y" "model" "HP5100" "A4" "m" "L" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "横向打印OK")
))
(exit)
(princ)
)
后半部分是调用你的程序...未经测试可以参考

啵浪鼓

(defun pr1(/ pt1 pt2 ptlist delt key)
(setvar "cmdecho" 0)
(setvar "osmode" 39)
(setq ptlist NIL)
(setq pt1 (getpoint "\n输入角点:"))
(setq pt2 (getcorner pt1 "\n输入另一角点:"))
(setq ptlist (cons (list pt1 pt2) ptlist))
(setq delt t)
(while delt
(initget "A C Y")
(setq key (getkword "\n[继续选择'A'/取消上次选择'C'/开始打印'Y'] <回车或空格开始打印'Y'>:"))
(if (= key nil) (setq key "Y"))
(cond ((= key "A") (progn (setq pt1 (getpoint "输入角点:"))
(setq pt2 (getcorner pt1 "\n输入另一角点:"))
(setq delt t)
(setq ptlist (cons (list pt1 pt2) ptlist))
))
((= key "C") (if (= nil ptlist) (progn (alert"\n没有选择!") (setq delt NIL))
(PROGN(setq ptlist (vl-remove (last ptlist) ptlist))
(setq delt t)
)))
((= key "Y") (setq delt nil))
)
)
(SETVAR "OSMODE" 0)
(if (= nil ptlist) (exit))
(foreach item ptlist (pr11 (car item) (cadr item)))
(prin1)
)
(defun pr11 (pt1 pt2 / pt1x pt1y pt2x pt2y)
(setq pt1x (nth 0 pt1)
pt1y (nth 1 pt1)
pt2x (nth 0 pt2)
pt2y (nth 1 pt2)
)
(if (< (abs (- pt1x pt2x)) (abs (- pt1y pt2y)))
(progn
(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "90度打印OK"))
(progn
(command "-plot" "y" "model" "HP5100" "A4" "m" "L" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "0度打印OK")
))
(exit)
(princ)
)

按照你写的改了一下，问题有二：
1，减去记忆中的打印点是从1开始计数，而不是倒计数，也就是我在选择到第3次框选时发现选错了，要减去上一次的也就是要减去最后一次第3次的框选，（这删减记忆应为倒计从最后到最初3~2~1），而程序却是从第一次所选开始删（实为1~2~3）
2，知道我为何将程序开始改成（defun pr1 。。。吗？因为这是一个主程序的分段，而我将你这段程序加进后再执行程序，选了2次框选后按打印出图时只打印了一次就提示错误：
[继续选择'A'/取消上次选择'C'/开始打印'Y'] <回车或空格开始打印'Y'>: 0度打印OK;
error: quit / exit abort

为什么我要在程序的结尾加写（exit）呢，因为不写这句的话，打印完框选子程序后会重复执行主程序全部从头自动打印一次的，所以这（exit）是不可少，除非你找出毛病来改掉我全段程序的问题之所在，附上全段程序，烦改良~谢了~

舟自横

哦!知道是什么情况了,,我没有经过测试,这台机器是主机..不
是我的电脑...所以不好测试..但你所说的情况我看了一下..是有点问题
你首先把(setq ptlist (CONS (LIST PT1 PT2) ptlist))改为
(setq ptlist (append ptlist (list (list pt1 pt2))))这样就改变了删除的次序了
因为前面用了CONS所以每次加点都会加在列表的最前面..其余改良等我看完你的主程序再说吧....
已经大概看了一下因为你那个子程序中有(EXIT)所以
执行了一遍就会被强行退出..给你改了一下
[php]
(defun c:prn( / ok cmde osmo cmdd s i na3 na4 na5 s1 p1 scl p2 notes fi s3 s4 sb)
              (princ "歡迎進入列印系統")
              (setvar "cmdecho" 0)
              (command "ucsicon" "n")
              (command "ucsicon" "on")
              (command "ucs" "world")
              (initget " 1 2 3 4 ")
              (setq ok(getkword "\n[對角列印A4按'1'/對角列印A3按'2'/列印A3按'3'/列印A4按'4']<空格或回車印所有A4>:"))
              (cond ((= "1" ok)(progn(setq s nil)(pr1)))
                    ((= "2" ok)(progn(setq s nil)(pr2)))
                    ((= "3" ok)(progn(setq s nil)(pr3)))
                    ((= "4" ok)
                 (setq s(ssget '(
                                  (0 . "INSERT")
                                  (-4 . "<or")
                                  (2 . "A3")(2 . "A4")(2 . "BOM1")(2 . "bomx")
                                  (-4 . "or>"))))
                     )
                    (t
                 (SETQ s(SSGET "X"'(
                                     (0 . "INSERT")
                                     (-4 . "<or")
                                     (2 . "A3")(2 . "A4")(2 . "BOM1")(2 . "bomx")
                                     (-4 . "or>"))))
                     )
              );;;;此處你用IF條件判斷是有問題的..也就是你所說的重復列印兩次的問題所在
               ;;;;因為你前面用IF判斷了OK如果是"1"或"2" "3"那么當遇到你所寫的如果OK不
               ;;;;為"4"的話程序將會把S建立不為"4"情況的選集等于說﹐你前面調用(pr1)執行
               ;;;;了一次打印命令。然后S選集又存在的情況下進入你下面的程序又執行了一次
               ;;;打印命令改為COND判斷則不會存在這個問題。因為COND只會取得其中的一種情況
               ;;;改過候你可以把后面子程序中的(exit)去掉了...
              (command "zoom" "e" "ucs" "world")
              (setq s3 (ssadd) s33 (ssadd) s333 (ssadd) s4 (ssadd) sb (ssadd) i 0)
           (if s
             (progn
              (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" "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 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" "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 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 notes(strcat "列印完畢! 列印 'A4-0' = "(itoa na3)" 張, 'A4-90'= "(itoa na33)" 張,'A4-180'= "(itoa na333)" 張!!!!!"))
              (print notes)
              )
             )
              (setvar "osmode" 39)
              (setvar "cmddia" 1)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 s3 (ssadd) s33 (ssadd) s333 (ssadd) i 0)
           (if s
              (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))
                (setq i (+ i 1)))
            )
        (setq qty1 0 i 0)
        (while (< i (sslength s3))
            (setq li (entget (ssname s3 i)))
            (setq qty1 (+ qty1 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 qty2 0 i 0)
        (while (< i (sslength s33))
            (setq li (entget (ssname s33 i)))
            (setq qty2 (+ qty2 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" "p" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
        (setq i (+ i 1 )))
        (setq qty3 0 i 0)
        (while (< i (sslength s333))
            (setq li (entget (ssname s333 i)))
            (setq qty3 (+ qty3 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" "p" "y" "w" p1 p2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
        (setq i (+ i 1 )))
    (setq notes(strcat "列印完畢! 列印 'A3-0' = "(rtos qty1 2 0)" 張, 'A3-90'= "(rtos qty2 2 0)" 張,'A3-180'= "(rtos qty3 2 0)" 張!!!!!"))
    (print notes)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pr2 (/ pt1 pt2 pt1x pt1y pt2x pt2y)
(princ "\n執行對角列印A3圖紙---無圖框時使用---")
  (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)))
      (progn
        (command "-plot" "y" "model" "HP5100" "A3" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
        (princ "90度列印OK"))
      (progn
        (command "-plot" "y" "model" "HP5100" "A3" "m" "L" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
      (princ "0度列印OK")
    ))
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pr1(/ pt1 pt2 ptlist delt key)
(setvar "cmdecho" 0)
(setvar "osmode" 39)
(setq ptlist NIL)
(setq pt1 (getpoint "\n輸入角點:"))
(setq pt2 (getcorner pt1 "\n輸入另一角點:"))
(setq ptlist (cons (list pt1 pt2) ptlist))
(setq delt t)
(while delt
(initget "A C Y")
(setq key (getkword "\n[繼續選擇'A'/取消上次選擇'C'/開始列印'Y'] <回車或空格開始列印'Y'>:"))
(if (= key nil) (setq key "Y"))
(cond ((= key "A") (progn (setq pt1 (getpoint "輸入角點:"))
(setq pt2 (getcorner pt1 "\n輸入另一角點:"))
(setq delt t)
(setq ptlist (append ptlist (list (list pt1 pt2))))
))
((= key "C") (if (= nil ptlist) (progn (alert"\n沒有選擇!") (setq delt NIL))
(PROGN(setq ptlist (vl-remove (last ptlist) ptlist))
(setq delt t)
)))
((= key "Y") (setq delt nil))
)
)
(SETVAR "OSMODE" 0)
(if (= nil ptlist) (exit))
(foreach item ptlist (pr11 (car item) (cadr item)))
(prin1)
)


(defun pr11 (pt1 pt2 / pt1x pt1y pt2x pt2y)
(setq pt1x (nth 0 pt1)
pt1y (nth 1 pt1)
pt2x (nth 0 pt2)
pt2y (nth 1 pt2)
)
(if (< (abs (- pt1x pt2x)) (abs (- pt1y pt2y)))
(progn
(command "-plot" "y" "model" "HP5100" "A4" "m" "p" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "90度列印OK"))
(progn
(command "-plot" "y" "model" "HP5100" "A4" "m" "L" "y" "w" pt1 pt2 "fit" "c" "y" "acad.ctb" "y" "n" "n" "n" "y")
(princ "0度列印OK")
))
(princ)
)
[/php]
去掉(EXIT)后一身轻松了吧?呵呵...由于比较忙
我只是找出了问题所在改了一下,未测试..不过
也就那个意思了

啵浪鼓

呵呵，强~！下午回公司测试一下，应该没什么问题的

果单皮

呵呵，老舟强啊，pfpf

老舟，为啥你输入的汉字都是繁体，装裤是不？哈哈~~~

小啵，你先当下小白鼠，测试一下，然后写下测试报告，

再向你三楼发的那样，都整理好了，（该变简体的地方，变简

体），然后再发上来！

嘿嘿^_^

舟自横

不是装酷...是我的电脑是繁体的...这台是主机动简体...
懂怎么回事了吗>: 呵呵...

果单皮

我运行了下程序，怎么出现了这个~~~？

Error: invalid dotted pair*Cancel*

改了下小啵的程序，程序可运行，在选择对角打印A3

的时侯，没有提示加选,取消的选项，直接就开始打印了，A4就可

以，但在取消上次选择的时侯，就退出了，why?

舟自横

不是句法有问题,是网路传送的问题..不知道为什么
上贴程序如果不用专门的PHP会把(-4 ."<OR")
破坏掉,我编辑了一下贴你重新下

果单皮

最初由 舟自横 发布
[B]不是句法有问题,是网路传送的问题..不知道为什么
上贴程序如果不用专门的PHP会把(-4 ."<OR")
破坏掉,我编辑了一下贴你重新下 [/B]

老舟，对角打印A3没有这个选项 (继续选择'A'/取消上次选择'C'/开始打印'Y')

A4的也无法取消上次选择？？？？

舟自横

肯定是这样的啊!!只用第一种条件即
"对角列印A4"才会有(继续选择'A'/取消上次选择'C'/开始打印'Y')
选项...你没看程序吗
只有第一种条件下才会调用PR1子程序才会有这个选则的
程序又不是我写的,我只是改了一下...具体也没有测试过
...其实我有用VB写过一个快速打印的程序..你可以在论坛里找
一下...只要图框是块..就适用...没必要搞的这么复杂..
另..很少QQ的   QQ:120167051

果单皮

老舟，你那个程序在R14平台下用不了
，555，这个程序又有上面存在的问题？
取消上次选择无效？


哪位大虾能给它改完美了，期待中。。。

cq_qg

怎么不能用啊？启动命令是什么？

果单皮

最初由 cq_qg 发布
[B]怎么不能用啊？启动命令是什么？ [/B]

加载此程序，然后command下，prn回车

啵浪鼓

改正后的打印程序