lisp如何实现实时动态显示

fawn_lgc

使用(grread)实时拖动画圆的程序已做成,特棒!遗憾的是不能使用命令行输入半径,仅能使用鼠标点取,对象捕捉也不能用,有什么办法可以解决吗?请各位高人出谋划策.
  另外,程序中不少LISP函数我是第一次使用,用法是否合理妥当还请各位大虾批评指正.
  再另外,惊悉alin大人的电脑不能使用中文,不得不使用english,你的帖子我费了九牛二虎力还是一知半解,不知我是否真正领悟您了的教诲.
  最后补充一句,为了更好的说明问题,还是以一个"简单"的画圆程序吧(说心里话即使这样这程序还是很难写),它也应当也必能适用于绘制其他自定义的图形.


;;;使用实时拖动绘制一个圆的程序如下:

(defun c:CIRC (/ centre motion pt radius ename1 ename2 circle line boolean code)
  (defun *error* (msg)
    (if        (and (/= msg "Function cancelled")(/= msg "函数被取消"))
      (princ (strcat "天方夜谭!" msg "\n"))
      (if motion(progn(entdel ename1)(entdel ename2)))
      )
    (princ)
  )

  
  ;;***主程序***
  (setq centre (getpoint "\n圆心: "))
  (if (/= centre nil)
    (progn
      (princ "\n半径: ")
      (setq motion(grread t 15 0))
      (setq pt (car(cdr motion)))
      (setq radius(distance centre pt))
      (entmakex (list '(0 . "CIRCLE")(cons 10 centre)(cons 40 radius)));;初始圆
      (setq ename1 (entlast))
      (setq circle (entget ename1))
      (entmakex (list '(0 . "line")(cons 10 centre)(cons 11 pt)))  ;;初始引线
      (setq ename2 (entlast))
      (setq line (entget ename2))
      (setq boolean T)
      (while boolean                  
        (setq motion(grread t 15 0))      ;;动态绘图
        (setq code(car motion))
        (if (or(= code 3)(= code 5))
          (progn
            (setq pt (car(cdr motion)))
            (setq radius(distance centre pt))
            (setq circle (subst (cons '40 radius)(assoc 40 circle)circle))   
            (setq line (subst (cons '11 pt)(assoc 11 line)line))            
            (entmod circle)                    ;;动态显示圆
            (entmod line)                      ;;动态显示引线
            )
          (entdel ename1)
          )
        (if (/= code 5)(setq boolean nil))  ;;选定点为真则退出
        )
      (entdel ename2)   ;;;删除引线
      )
    )
    (princ)
)





没有最好,只有更好!
有条件要上,没条件也上!
别人能做到的,我们一定能做到,别人做不到的,我们也要做到!
嗨...口干了.

fawn_lgc

dbczhaoy

hothua

(defun c:CIRC (/ centre motion pt radius ename1 ename2 circle line boolean code udist char nn)
  (defun *error* (msg)
    (if (and (/= msg "Function cancelled")(/= msg "函数被取消"))
      (princ (strcat "天方夜谭!" msg "\n"))
      (if motion(progn(entdel ename1)(entdel ename2)))
      )
    (princ)
  )

   
  ;;***主程序***
  (setq centre (getpoint "\n圆心: "))
  (if (/= centre nil)
    (progn
      (princ "\n半径: ")
      (setq motion(grread t 15 0))
      (setq pt (car(cdr motion)))
      (setq radius(distance centre pt))
      (entmakex (list '(0 . "CIRCLE")(cons 10 centre)(cons 40 radius)));;初始圆
      (setq ename1 (entlast))
      (setq circle (entget ename1))
      (entmakex (list '(0 . "line")(cons 10 centre)(cons 11 pt)))  ;;初始引线
      (setq ename2 (entlast))
      (setq line (entget ename2))
      (setq boolean T)
      (setq udist "")
      (while boolean                  
        (setq motion(grread t 15 0))      ;;动态绘图         
        (setq code(car motion))
        (if (= code 2)
          (progn
            (setq char (cadr motion))
            (cond
              ( (= char 8) ;当奇数次击键退格键无效，不知道为何？               
                (setq nn (strlen udist))
                (if (> nn 0)
                  (setq udist (substr udist 1 (1- nn)))
                )
              );
              ( (or (and (>= char 48)(<= char 57)) (= char 46))
                (setq udist (strcat udist (chr char)))
              )
            )
            (if (/= udist "")
              (progn
                (setq radius(atof udist))
                (setq circle (subst (cons '40 radius)(assoc 40 circle)circle))
                (entmod circle)  
              )
            )     
            (print udist)
          )
        )
        
        (if (and (or(= code 3)(= code 5))(= udist "")) ;当键盘输入不为空时，以键盘为准
        　(progn
            (setq pt (car(cdr motion)))
            (setq radius(distance centre pt))
            (setq circle (subst (cons '40 radius)(assoc 40 circle)circle))   
            (setq line (subst (cons '11 pt)(assoc 11 line)line))            
            (entmod circle)                    ;;动态显示圆
            (entmod line)                      ;;动态显示引线
          )
        )
        ;
        (entupd ename1)
        (entupd ename2)
        (if (or (= code 3)(and (= code 2) (or (= char 13) (= char 32))))
          (setq boolean nil)
        )  ;;选定点为真则退出
      )
      (entdel ename2)   ;;;删除引线
   )
)
(princ)
)

alin

;;;使用实时拖动绘制一个圆的程序如下:
(defun c:CIRC (/ centre motion pt radius ename1 ename2 circle line boolean code
                 keyrad keylist)
  (defun *error* (msg)
    (if (and (/= msg "Function cancelled")(/= msg "函数被取消"))
      (princ (strcat "天方夜谭!" msg "\n"))
      (if motion(progn(entdel ename1)(entdel ename2)))
      )
    (princ)
  )   
  ;;***主程序***
  (setq keylist '(8 46 48 49 50 51 52 53 54 55 56 57))   ;设置输入时允许使用的键盘键
  (setq keyrad "")
  (setq centre (getpoint "\nCIRC指定圆的圆心: "))
  (if (/= centre nil)
    (progn
      (princ "\n指定圆的半径<")
      (if rad (princ rad))(princ ">: ")
      (setq motion(grread t 15 0))
      (setq pt (car(cdr motion)))
      (setq radius(distance centre pt))
      (entmakex (list '(0 . "CIRCLE")(cons 10 centre)(cons 40 radius)));;初始圆
      (setq ename1 (entlast))
      (setq circle (entget ename1))
      (entmakex (list '(0 . "line")(cons 10 centre)(cons 11 pt)))  ;;初始引线
      (setq ename2 (entlast))
      (setq line (entget ename2))
      (setq boolean T)
      (while boolean                  
        (setq motion (grread t 15 0))      ;;动态绘图
        (setq code(car motion))
          (cond ((= code 5) ;鼠标游移
                 (setq pt (car(cdr motion)))
                 (setq radius(distance centre pt))
                 (setq circle (subst (cons '40 radius)(assoc 40 circle)circle))   
                 (setq line (subst (cons '11 pt)(assoc 11 line)line))            
                 (entmod circle)                    ;;动态显示圆
                 (entmod line)                      ;;动态显示引线
                )
                ((= code 3) ;鼠标左键按下
                 (setq pt (car(cdr motion)))
                 (setq radius(distance centre pt))
                 (setq circle (subst (cons '40 radius)(assoc 40 circle)circle))   
                 (setq line (subst (cons '11 pt)(assoc 11 line)line))            
                 (entmod circle)                    ;;显示圆
                 (entmod line)                      ;;显示线
                 (setq boolean nil)
                )
                ((and (= code 2)(member (car (cdr motion)) keylist)) ;允许使用的键盘键按下
                 (if (/= (car (cdr motion)) 8)   ;不是退格键
                     (progn
                             (princ (chr (car (cdr motion))))
                         (setq keyrad (strcat keyrad (chr (car (cdr motion)))))
                     );progn
                     (progn
                         (setq keyrad (substr keyrad 1 (1- (strlen keyrad))))                       
                         (princ "\n指定圆的半径<")(if rad (princ rad))(princ ">: ")(princ keyrad)
                     );progn
                  );endif
                  (if (= keyrad "")
                      (setq keylist '(46 48 49 50 51 52 53 54 55 56 57)) ;如果输入为空,不允许使用退格键
                      (setq keylist '(8 46 48 49 50 51 52 53 54 55 56 57))
                  )
                )
                ((or (and (= code 2)(= 13 (car (cdr motion)))) ;回车键按下 或者
                     (= code 11))            ;鼠标右键按下,有的鼠标设置为code = 25
                 (if (= (vl-string-search "." keyrad) 0)
                   (setq keyrad (strcat "0" keyrad)))
                 (if (= keyrad "")
                     (setq radius rad)
                     (setq radius (read keyrad))
                 )
                 (setq circle (subst (cons '40 radius)(assoc 40 circle)circle))   
                 (setq line (subst (cons '11 pt)(assoc 11 line)line))            
                 (entmod circle)                    ;;显示圆
                 (entmod line)                      ;;显示引线
                 (setq boolean nil)
                )
            )
  );while
      (entdel ename2)   ;;;删除引线
      )
    )
  (setq rad radius)
  (princ)
)

fawn_lgc

输入命令后出现下列窗口显示出错

alin

dbczhaoy

dbczhaoy

dbczhaoy