(XD::Doc:GetPolygon)取点

eachy · 发表于 2014-10-29 11:42:50

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

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

×

;|
info1 -- 第一点提示字符串
info2 -- 第二点及以后提示字串
col -- 颜色 , 负数实线,正整数虚线
|;
(defun XD::Doc:GetPolygon (info1 info2 col / bp con fuzz i ll myerr olderr p
pickmode pnt ptl pts ret ret1 tf tf1 x
)
(defun _pnt:projectOnAxis (bp pnt /)
(if (zerop (getvar "orthomode"))
pnt
(if (or
(< (* pi 0.25) (angle bp pnt) (* 0.75 pi))
(< (* pi 1.25) (angle bp pnt) (* 1.75 pi))
)
(list (car bp) (cadr pnt) 0.)
(list (car pnt) (cadr bp) 0.)
)
)
)
(defun myerr (msg)
(princ "\r*cancel*")
(xdrx_pointmonitor)
(xdrx_sysvar_pop)
(redraw)
(princ)
)
(defun _grdraw (pts /)
(if (>= (length pts) 2)
(progn
(redraw)
(apply
'xdrx_grdraw
(cons col (cons con pts))
)
(xdrx_grdraw col con (car pts) (last pts))
)
)
)
(defun callback (p / ll)
(if ptl
(progn ; (princ "\r")
; (princ (trans p 0 1))
(_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")
)
(if (and
(= (type #XD-VAR-FUNC-DRAG-MOUSEMove-CallBack) 'STR)
(= (type (eval (read #XD-VAR-FUNC-DRAG-MOUSEMove-CallBack))) 'SUBR)
)
(eval (list (read #XD-VAR-FUNC-DRAG-MOUSEMove-CallBack) (read "p")))
)
)
)
) ; 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 '("apbox" 1))
(princ (getvar "apbox"))
(setq i 0)
(while (and
tf
(progn
(setq ret (getpoint (if tf1
(if info1
(strcat "\n" info1 "<退出>: ")
"\n第一点<退出>: "
)
(if (> i 1)
(progn
(initget 128 "U")
(xdrx_initget 128 "U")
(if info2
(strcat "\r" info2 "[回退(U)]<退出>: ")
"\r下一点[回退(U)]<退出>: "
)
)
(if info2
(strcat "\n" info2 "<退出>: ")
"\n下一点<退出>: "
)
)
)
)
)
)
)
(cond
((= ret "U")
(setq ret1 ret)
(if (> (length ptl) 1)
(setq ret (cadr ptl)
ptl (cdr ptl)
)
)
(setq i (1- i))
(if (= i 1)
(setq tf1 nil)
)
)
((= (type ret) 'LIST)
(setq ret1 ret)
(setq i (1+ i))
(setq tf1 nil)
(if (and
ptl
(equal ret (last ptl) fuzz)
)
(setq tf nil)
)
(setq pickmode tf)
(if ptl
(setq ptl (cons (_pnt:projectOnAxis (car ptl) ret) ptl))
(setq ptl (cons ret ptl))
)
)
(t
nil
)
)
(if (and
(= (type #XD-VAR-FUNC-DRAG-MOUSELeftClick-CallBack) 'STR)
(= (type (eval (read #XD-VAR-FUNC-DRAG-MOUSELeftClick-CallBack))) 'SUBR)
)
(eval (list (read #XD-VAR-FUNC-DRAG-MOUSELeftClick-CallBack) (read "ret1")))
)
)
(setq *error* olderr)
(xdrx_sysvar_pop)
(xdrx_pointmonitor)
(redraw)
(if (not tf)
(setq ptl (reverse (cdr ptl)))
(setq ptl (reverse ptl))
)
(if (> (length ptl) 2)
ptl
nil
)
)

;| 
info1 -- 第一点提示字符串 
info2 -- 第二点及以后提示字串 
col -- 颜色 , 负数实线,正整数虚线 
|; 
(defun XD::Doc:GetPolygon (info1 info2 col / bp con fuzz i ll myerr olderr p 
                                 pickmode pnt ptl pts ret ret1 tf tf1 x 
                          ) 
  (defun _pnt:projectOnAxis (bp pnt /) 
    (if (zerop (getvar "orthomode")) 
      pnt 
      (if (or 
            (< (* pi 0.25) (angle bp pnt) (* 0.75 pi)) 
            (< (* pi 1.25) (angle bp pnt) (* 1.75 pi)) 
          ) 
        (list (car bp) (cadr pnt) 0.) 
        (list (car pnt) (cadr bp) 0.) 
      ) 
    ) 
  ) 
  (defun myerr (msg) 
    (princ "\r*cancel*") 
    (xdrx_pointmonitor) 
    (xdrx_sysvar_pop) 
    (redraw) 
    (princ) 
  ) 
  (defun _grdraw (pts /) 
    (if (>= (length pts) 2) 
      (progn 
        (redraw) 
        (apply 
          'xdrx_grdraw 
          (cons col (cons con pts)) 
        ) 
        (xdrx_grdraw col con (car pts) (last pts)) 
      ) 
    ) 
  ) 
  (defun callback (p / ll) 
    (if ptl 
      (progn                               ; (princ "\r") 
                                       ; (princ (trans p 0 1)) 
        (_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") 
        ) 
        (if (and 
              (= (type #XD-VAR-FUNC-DRAG-MOUSEMove-CallBack) 'STR) 
              (= (type (eval (read #XD-VAR-FUNC-DRAG-MOUSEMove-CallBack))) 'SUBR) 
            ) 
          (eval (list (read #XD-VAR-FUNC-DRAG-MOUSEMove-CallBack) (read "p"))) 
        ) 
      ) 
    ) 
  )                                       ; 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 '("apbox" 1)) 
  (princ (getvar "apbox")) 
  (setq i 0) 
  (while (and 
           tf 
           (progn 
             (setq ret (getpoint (if tf1 
                                   (if info1 
                                     (strcat "\n" info1 "<退出>: ") 
                                     "\n第一点<退出>: " 
                                   ) 
                                   (if (> i 1) 
                                     (progn 
                                       (initget 128 "U") 
                                       (xdrx_initget 128 "U") 
                                       (if info2 
                                         (strcat "\r" info2 "[回退(U)]<退出>: ") 
                                         "\r下一点[回退(U)]<退出>: " 
                                       ) 
                                     ) 
                                     (if info2 
                                       (strcat "\n" info2 "<退出>: ") 
                                       "\n下一点<退出>: " 
                                     ) 
                                   ) 
                                 ) 
                       ) 
             ) 
           ) 
         ) 
    (cond 
      ((= ret "U") 
        (setq ret1 ret) 
        (if (> (length ptl) 1) 
          (setq ret (cadr ptl) 
                ptl (cdr ptl) 
          ) 
        ) 
        (setq i (1- i)) 
        (if (= i 1) 
          (setq tf1 nil) 
        ) 
      ) 
      ((= (type ret) 'LIST) 
        (setq ret1 ret) 
        (setq i (1+ i)) 
        (setq tf1 nil) 
        (if (and 
              ptl 
              (equal ret (last ptl) fuzz) 
            ) 
          (setq tf nil) 
        ) 
        (setq pickmode tf) 
        (if ptl 
          (setq ptl (cons (_pnt:projectOnAxis (car ptl) ret) ptl)) 
          (setq ptl (cons ret ptl)) 
        ) 
      ) 
      (t 
        nil 
      ) 
    ) 
    (if (and 
          (= (type #XD-VAR-FUNC-DRAG-MOUSELeftClick-CallBack) 'STR) 
          (= (type (eval (read #XD-VAR-FUNC-DRAG-MOUSELeftClick-CallBack))) 'SUBR) 
        ) 
      (eval (list (read #XD-VAR-FUNC-DRAG-MOUSELeftClick-CallBack) (read "ret1"))) 
    ) 
  ) 
  (setq *error* olderr) 
  (xdrx_sysvar_pop) 
  (xdrx_pointmonitor) 
  (redraw) 
  (if (not tf) 
    (setq ptl (reverse (cdr ptl))) 
    (setq ptl (reverse ptl)) 
  ) 
  (if (> (length ptl) 2) 
    ptl 
    nil 
  ) 
)

eachy · 发表于 2014-10-29 23:55:23

更新, 支持自定义虚线颜色

eachy · 发表于 2014-11-4 15:56:15

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

sahe · 发表于 2015-1-9 19:22:45

不能使用覺得沒有效果

XDSoft · 发表于 2015-1-9 20:01:43

sahe 发表于 2015-1-9 19:22
不能使用覺得沒有效果

不能使用是因为你没会用。

20055647 · 发表于 2015-1-9 20:37:45

新手，好多都看不懂

XDSoft · 发表于 2016-7-8 14:06:46

2016.0708更新该函数，回调函数，回调函数通过 (XD::Drag:SetMouseMoveCallBack ...)和(XD::Drag:SetMouseClickCallBack ....)设置。

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

[[coior=red]文档类] (XD::Doc:GetPolygon)取点

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

点评