回关于橡皮筋问题——在Lisp中

mkhsj927

这是我编的程序中的一个函数，分析分析一下吧
(defun select_a_pmx        (/ tp val fg ent_pmx pt pt_array n pt1 pt2)
;选择或画出剖切线,返回顶点表pt_array(点1 点2 ...)
        (princ "选择(Select)/<第1点>:")
        (setq fg 0)
        (while fg
                (setq tp (car (setq val (grread nil 5))))
                (cond
                        ((= 2 tp)
                         (if (or (= 83 (cadr val)) (= 115 (cadr val)))
                                 (setq fg nil)
                         )
                        )
                        ((= 3 tp) (setq fg nil))        ;83、115分别为字母"S"、"s"的ASCII码
                )
        )
        (cond
                ((= 2 tp)                                                ;键盘按
                 (while
                         (null (setq ent_pmx (car (entsel "\n请选择一条剖切线:"))))
                 )
                 (setq pt_array (reverse (plvt ent_pmx)))
                )
                ((= 3 tp)                                                ;鼠标
                 (setq pt                (reverse (cdr (reverse (cadr val))))
                           pt_array        (list pt)
                 )
                 (setq n  1
                           fg 0
                 )
                 (while        fg
                         (setq n   (1+ n)
                                   pt1 pt
                         )
                         (princ (strcat "\n第" (itoa n) "点:\n"))
                         (setq pt2 (cadr (grread 0 5)))
                         (grdraw pt1 pt2 -1)
                         (while
                                 (and (/= 3 (car (setq val (grread 0 5))))
                                          (/= 11 (car val))
                                 )
                                        (grdraw pt1 pt2 -1)
                                        (setq pt2 (cadr val))
                                        (grdraw pt1 pt2 -1)
                         )
                         (if (= 3 (car val))
                                 (progn        (setq pt           (reverse (cdr (reverse (cadr val))))
                                                          pt_array (cons pt pt_array)
                                                )
                                 )
                                 (progn (grdraw pt1 pt2 -1) (setq fg nil))
                         )
                 )
                 (setq pt_array (reverse pt_array))
                 (command "redraw")
                 (apply 'command (cons "pline" pt_array))
                 (command)
                 (setq ent_pmx (ssname (ssget "L") 0))
                )
        )
        (setq pt_array (list pt_array ent_pmx))
)
主要分析grread函数！

meflying

这样使用GRREAD总觉得不是很合适