(XD::Doc:GetFence)获取 Fence 栏选点

eachy · 发表于 2014-10-30 02:41:19

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun XD::Doc:GetFence (info1 info2 col /
_pnt:projectOnAxis myerr _grdraw
callback ret ptl tf
tf1 fuzz con
)
(defun _pnt:projectOnAxis (bp p /)
(if (zerop (getvar "orthomode"))
p
(if (or (< (* pi 0.25) (angle bp p) (* 0.75 pi))
(< (* pi 1.25) (angle bp p) (* 1.75 pi))
)
(list (car bp) (cadr p) 0.)
(list (car p) (cadr bp) 0.)
)
)
)
(defun myerr (msg)
(princ "\n*cancel*")
(xdrx_sysvar_pop)
(xdrx_pointmonitor)
(redraw)
(princ)
)
(defun _grdraw (pts /)
(if (>= (length pts) 2)
(progn
(redraw)
(apply 'xdrx_grdraw (cons col (cons con pts)))
)
)
)
(defun callback (p / ll)
(if ptl
(progn
(_grdraw
(cons
(trans (_pnt:projectOnAxis (car ptl) (trans p 0 1))
1
0
)
(mapcar '(lambda (x) (trans x 1 0)) ptl)
)
)
(if (and (> (length ptl) 1)
(equal (trans p 0 1) (last ptl) fuzz)
)
(xdrx_document_sendCmdStr "\n")
)
)
)
)
;;main
(setq olderr *error*
*error* myerr
tf t
tf1 t
fuzz (XD::Doc:GetPickBoxHeight)
)
(if (not col)
(setq col 1)
)
(if (minusp col)
(setq con 0
col (abs col)
)
(setq con 1)
)
(xdrx_pointmonitor "callback")
(xdrx_sysvar_push '("orthomode" 0) '("apbox" 1))
(while (and tf
(progn
(initget 128 "U")
(setq ret (getpoint (if tf1
(if info1
(strcat "\n" info1 "<退出>: ")
"\r第一点<退出>: "
)
(if info2
(strcat "\r" info2 "[回退(U)]: ")
"\n下一点[回退(U)]: "
)
)
)
)
(cond
((= ret "U")
(if (> (length ptl) 1)
(setq ret (cadr ptl)
ptl (cddr ptl)
)
)
)
((= (type ret) 'LIST)
ret
)
(t nil)
)
)
)
(setq tf1 nil)
(if (and ptl (equal ret (last ptl) fuzz))
(setq tf nil)
)
(if ptl
(setq ptl (cons (_pnt:projectOnAxis (car ptl) ret) ptl))
(setq ptl (cons ret ptl))
)
)
(setq *error* olderr)
(xdrx_sysvar_pop)
(xdrx_pointmonitor)
(redraw)
(if (not tf)
(reverse (cdr ptl))
(reverse ptl)
)
)

(defun XD::Doc:GetFence        (info1            info2      col          / 
                         _pnt:projectOnAxis    myerr          _grdraw 
                         callback   ret               ptl          tf 
                         tf1            fuzz       con 
                        ) 
  (defun _pnt:projectOnAxis (bp p /) 
    (if        (zerop (getvar "orthomode")) 
      p 
      (if (or (< (* pi 0.25) (angle bp p) (* 0.75 pi)) 
              (< (* pi 1.25) (angle bp p) (* 1.75 pi)) 
          ) 
        (list (car bp) (cadr p) 0.) 
        (list (car p) (cadr bp) 0.) 
      ) 
    ) 
  ) 
  (defun myerr (msg) 
    (princ "\n*cancel*") 
    (xdrx_sysvar_pop) 
    (xdrx_pointmonitor) 
    (redraw) 
    (princ) 
  ) 
  (defun _grdraw (pts /) 
    (if        (>= (length pts) 2) 
      (progn 
        (redraw) 
        (apply 'xdrx_grdraw (cons col (cons con pts))) 
      ) 
    ) 
  ) 
  (defun callback (p / ll) 
    (if        ptl 
      (progn 
        (_grdraw 
          (cons 
            (trans (_pnt:projectOnAxis (car ptl) (trans p 0 1)) 
                   1 
                   0 
            ) 
            (mapcar '(lambda (x) (trans x 1 0)) ptl) 
          ) 
        ) 
        (if (and (> (length ptl) 1) 
                 (equal (trans p 0 1) (last ptl) fuzz) 
            ) 
          (xdrx_document_sendCmdStr "\n") 
        ) 
      ) 
    ) 
  ) 
  ;;main 
  (setq        olderr        *error* 
        *error*        myerr 
        tf        t 
        tf1        t 
        fuzz        (XD::Doc:GetPickBoxHeight) 
  ) 
  (if (not col) 
    (setq col 1) 
  ) 
  (if (minusp col) 
    (setq con 0 
          col (abs col) 
    ) 
    (setq con 1) 
  ) 
  (xdrx_pointmonitor "callback") 
  (xdrx_sysvar_push '("orthomode" 0) '("apbox" 1)) 
  (while (and tf 
              (progn 
                (initget 128 "U") 
                (setq ret (getpoint (if        tf1 
                                      (if info1 
                                        (strcat "\n" info1 "<退出>: ") 
                                        "\r第一点<退出>: " 
                                      ) 
                                      (if info2 
                                        (strcat "\r" info2 "[回退(U)]: ") 
                                        "\n下一点[回退(U)]: " 
                                      ) 
                                    ) 
                          ) 
                ) 
                (cond 
                  ((= ret "U") 
                   (if (> (length ptl) 1) 
                     (setq ret (cadr ptl) 
                           ptl (cddr ptl) 
                     ) 
                   ) 
                  ) 
                  ((= (type ret) 'LIST) 
                   ret 
                  ) 
                  (t nil) 
                ) 
              ) 
         ) 
    (setq tf1 nil) 
    (if        (and ptl (equal ret (last ptl) fuzz)) 
      (setq tf nil) 
    ) 
    (if        ptl 
      (setq ptl (cons (_pnt:projectOnAxis (car ptl) ret) ptl)) 
      (setq ptl (cons ret ptl)) 
    ) 
  ) 
  (setq *error* olderr) 
  (xdrx_sysvar_pop) 
  (xdrx_pointmonitor) 
  (redraw) 
  (if (not tf) 
    (reverse (cdr ptl)) 
    (reverse ptl) 
  ) 
)

newer · 发表于 2014-10-30 08:29:19

好函数，正想写个东西要用到。{:soso_e179:}

eachy · 发表于 2014-11-4 16:03:22

更新
1 支持实显或虚显
2 支持回退

kkt123 · 发表于 2015-2-23 17:55:42

好函数，正想写个东西要用到;P;P

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

[[coior=red]文档类] (XD::Doc:GetFence)获取 Fence 栏选点

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。