(XD::Doc:Getdist)获取距离向量（2016.5.24更新)

eachy · 发表于 2014-10-29 23:57:51

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

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

×

;|
basePnt --- 基点 or nil
info --- 提示字串 or nil
col --- 线颜色 or nil (红色) , 负数实线
xdir --- 自定义X轴向量
orthomode - T 强制垂直, 其它值随系统或随 xdir
|;
(defun XD::Doc:GetDist (basePnt info col xdir orthomode / _pnt:projectOnAxis
_pnt:GetdistOnAxis p1 v myerr callback olderr
con
)
(defun _pnt:GetdistOnAxis (bp p ucsxdir / baseAng vp tf1 tf2 lst dis sdis tf)
(setq lst (trans (mapcar '- p bp) 0 ucsxdir)
dis (distance bp p)
sdis (rtos dis 2 3)
tf (equal dis (atof sdis) 0.0001)
)
(if (or orthomode
(= (getvar "orthomode") 1)
)
(if (equal ucsxdir '(1.0 0.0 0.0))
(progn
(setq tf1 (< (* pi 0.25) (angle bp p) (* 0.75 pi))
tf2 (< (* pi 1.25) (angle bp p) (* 1.75 pi))
)
(if tf ;_input
(if (or tf1 tf2)
(polar bp
(if tf1
(/ pi 2)
(* pi 1.5)
)
dis
)
(polar bp
(if (or (< (angle bp p) (/ pi 2)) (> (angle bp p) (* 1.5 pi)))
0.0
pi
)
dis
)
)
(if (or tf1 tf2)
(list (car bp) (cadr p) 0.)
(list (car p) (cadr bp) 0.)
)
)
)
(progn
(setq baseAng (angle '(0. 0. 0.) ucsxdir))
(setq vp (trans (mapcar '- p bp) 0 ucsxdir))
(if
(or (<= (* 0.25 pi) (- (angle bp p) baseAng) (* 0.75 pi))
(<= (* 1.25 pi) (- (angle bp p) baseAng) (* 1.75 pi))
)
(polar bp
(+ (* pi 0.5) baseAng)
(if tf
dis
(car vp)
)
)
(polar bp
baseAng
(if tf
dis
(last vp)
)
)
)
)
)
p
)
)
(defun _pnt:projectOnAxis (bp p ucsxdir / baseAng vp)
(if (or orthomode
(= (getvar "orthomode") 1)
)
(if (equal ucsxdir '(1.0 0.0 0.0))
(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.)
)
(progn
(setq baseAng (angle '(0. 0. 0.) ucsxdir))
(setq vp (trans (mapcar '- p bp) 0 ucsxdir))
(if
(or (<= (* 0.25 pi) (- (angle bp p) baseAng) (* 0.75 pi))
(<= (* 1.25 pi) (- (angle bp p) baseAng) (* 1.75 pi))
)
(polar bp (+ (* pi 0.5) baseAng) (car vp))
(polar bp baseAng (last vp))
)
)
)
p
)
)
(defun myerr (msg)
(princ "\n*cancel*")
(xdrx_pointmonitor)
(xdrx_sysvar_pop)
(redraw)
(princ)
)
(defun callback (dynpt /)
(redraw)
(if (not (equal xdir '(1.0 0.0 0.) 1e-3))
(XD::Doc:DrawXAxis basePnt xdir 1)
)
(xdrx_grdraw
col
con
(trans basePnt 1 0)
(trans (_pnt:projectOnAxis basePnt (trans dynpt 0 1) xdir)
1
0
)
)
)
(setq olderr *error*
*error* myerr
)
(if (not col)
(setq col 1)
)
(if (minusp col)
(setq con 0
col (abs col)
)
(setq con 1)
)
(if xdir
(setq xdir (xdrx_vector_normalize xdir))
(setq xdir '(1.0 0.0 0.0))
)
(if (not basePnt)
(setq basePnt (getpoint "\n基点: "))
(setvar "lastpoint" basePnt)
)
(if basePnt
(progn
(setvar "lastpoint" basePnt)
(xdrx_pointmonitor "callback")
(xdrx_sysvar_push '("apbox" 1))
(setq p1 (getpoint (if info
info
"\n距离: "
)
)
)
(setq
v (mapcar '-
(_pnt:GetdistOnAxis basePnt p1 xdir)
basePnt
)
)
)
(and (setq p1 (getpoint (if info
info
"\n距离: "
)
)
)
(setq
v (mapcar '-
(_pnt:GetdistOnAxis basePnt p1 xdir)
basePnt
)
)
)
)
(setq *error* olderr)
(xdrx_pointmonitor)
(xdrx_sysvar_pop)
(redraw)
v
)

;| 
basePnt --- 基点 or nil 
info    --- 提示字串 or nil 
col     --- 线颜色 or nil (红色) , 负数实线 
xdir    --- 自定义X轴向量 
orthomode - T 强制垂直, 其它值 随系统或 随 xdir 
|; 
(defun XD::Doc:GetDist (basePnt      info   col        xdir     orthomode  /       _pnt:projectOnAxis 
   _pnt:GetdistOnAxis   p1        v     myerr  callback     olderr 
   con 
         ) 
  (defun _pnt:GetdistOnAxis (bp p ucsxdir / baseAng vp tf1 tf2 lst dis sdis tf) 
    (setq lst  (trans (mapcar '- p bp) 0 ucsxdir) 
   dis  (distance bp p) 
   sdis (rtos dis 2 3) 
   tf   (equal dis (atof sdis) 0.0001) 
    ) 
    (if (or orthomode 
     (= (getvar "orthomode") 1) 
 ) 
      (if (equal ucsxdir '(1.0 0.0 0.0)) 
 (progn 
   (setq tf1 (< (* pi 0.25) (angle bp p) (* 0.75 pi)) 
  tf2 (< (* pi 1.25) (angle bp p) (* 1.75 pi)) 
   ) 
   (if tf ;_input 
     (if (or tf1 tf2) 
       (polar bp 
       (if tf1 
         (/ pi 2) 
         (* pi 1.5) 
       ) 
       dis 
       ) 
       (polar bp 
       (if (or (< (angle bp p) (/ pi 2)) (> (angle bp p) (* 1.5 pi))) 
         0.0 
         pi 
       ) 
       dis 
       ) 
     ) 
     (if (or tf1 tf2) 
       (list (car bp) (cadr p) 0.) 
       (list (car p) (cadr bp) 0.) 
     ) 
   ) 
 ) 
 (progn 
   (setq baseAng (angle '(0. 0. 0.) ucsxdir)) 
   (setq vp (trans (mapcar '- p bp) 0 ucsxdir)) 
   (if 
     (or (<= (* 0.25 pi) (- (angle bp p) baseAng) (* 0.75 pi)) 
  (<= (* 1.25 pi) (- (angle bp p) baseAng) (* 1.75 pi)) 
     ) 
      (polar bp 
      (+ (* pi 0.5) baseAng) 
      (if tf 
        dis 
        (car vp) 
      ) 
      ) 
      (polar bp 
      baseAng 
      (if tf 
        dis 
        (last vp) 
      ) 
      ) 
   ) 
 ) 
      ) 
      p 
    ) 
  ) 
  (defun _pnt:projectOnAxis (bp p ucsxdir / baseAng vp) 
    (if (or orthomode 
     (= (getvar "orthomode") 1) 
 ) 
      (if (equal ucsxdir '(1.0 0.0 0.0)) 
 (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.) 
 ) 
 (progn 
   (setq baseAng (angle '(0. 0. 0.) ucsxdir)) 
   (setq vp (trans (mapcar '- p bp) 0 ucsxdir)) 
   (if 
     (or (<= (* 0.25 pi) (- (angle bp p) baseAng) (* 0.75 pi)) 
  (<= (* 1.25 pi) (- (angle bp p) baseAng) (* 1.75 pi)) 
     ) 
      (polar bp (+ (* pi 0.5) baseAng) (car vp)) 
      (polar bp baseAng (last vp)) 
   ) 
 ) 
      ) 
      p 
    ) 
  ) 
  (defun myerr (msg) 
    (princ "\n*cancel*") 
    (xdrx_pointmonitor) 
    (xdrx_sysvar_pop) 
    (redraw) 
    (princ) 
  ) 
  (defun callback (dynpt /) 
    (redraw) 
    (if (not (equal xdir '(1.0 0.0 0.) 1e-3)) 
      (XD::Doc:DrawXAxis basePnt xdir 1) 
    ) 
    (xdrx_grdraw 
      col 
      con 
      (trans basePnt 1 0) 
      (trans (_pnt:projectOnAxis basePnt (trans dynpt 0 1) xdir) 
      1 
      0 
      ) 
    ) 
  ) 
  (setq olderr *error* 
 *error* myerr 
  ) 
  (if (not col) 
    (setq col 1) 
  ) 
  (if (minusp col) 
    (setq con 0 
   col (abs col) 
    ) 
    (setq con 1) 
  ) 
  (if xdir 
    (setq xdir (xdrx_vector_normalize xdir)) 
    (setq xdir '(1.0 0.0 0.0)) 
  ) 
  (if (not basePnt) 
    (setq basePnt (getpoint "\n基点: ")) 
    (setvar "lastpoint" basePnt) 
  ) 
  (if basePnt 
    (progn 
      (setvar "lastpoint" basePnt) 
      (xdrx_pointmonitor "callback") 
      (xdrx_sysvar_push '("apbox" 1)) 
      (setq p1 (getpoint (if info 
      info 
      "\n距离: " 
    ) 
        ) 
      ) 
      (setq 
 v (mapcar '- 
    (_pnt:GetdistOnAxis basePnt p1 xdir) 
    basePnt 
   ) 
      ) 
    ) 
    (and (setq p1 (getpoint (if info 
         info 
         "\n距离: " 
       ) 
    ) 
  ) 
  (setq 
    v (mapcar '- 
       (_pnt:GetdistOnAxis basePnt p1 xdir) 
       basePnt 
      ) 
  ) 
    ) 
  ) 
  (setq *error* olderr) 
  (xdrx_pointmonitor) 
  (xdrx_sysvar_pop) 
  (redraw) 
  v 
)

eachy · 发表于 2014-11-5 09:51:29

更新，增加自定义 XAxis 及强制垂直模式
在自定义 Xdir 时用到的一个箭头提示

(defun XD::Doc:DrawXAxis (p v col / an an1 h h1 d1 d2 p1 p2 p3 p4 p5 p6
p7)
(setq an (angle '(0. 0. 0.) v)
an1 (+ an (/ pi 2))
h (getvar "viewsize")
h1 (/ h 80.)
d1 (* 0.25 (getvar "viewsize"))
d2 (* d1 0.7)
p1 (polar p an1 h1)
p2 (polar p1 an d2)
p3 (polar p2 an1 h1)
p4 (polar p an d1)
p5 (polar p (+ an1 pi) h1)
p6 (polar p5 an d2)
p7 (polar p6 (+ an1 pi) h1)
)
(grvecs (list col p5 p1 col p1 p2 col p2 p3 col p3 p4 col p4 p7 col p7
p6 col p6 p5)
)
t
)

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

[[coior=red]文档类] (XD::Doc:Getdist)获取距离向量（2016.5.24更新)

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