马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
 - (defun c:xdtb_curvedirec (/ mids segs e pt)
- (defun XD::Pnt:ToArraw (p v col w1 w2 h1 h2 / an an1 h1 p1 p2 p3 p4 p5 p6 p7)
- (setq an (angle '(0. 0. 0.) v)
- an1 (+ an (/ pi 2))
- h1 (/ h1 2.0)
- p1 (polar p an1 h1)
- p2 (polar p1 an w1)
- p3 (polar p2 an1 h2)
- p4 (polar p an (+ w1 w2))
- p5 (polar p2 (+ an1 pi) (+ (* 2 h1) h2))
- p6 (polar p2 (+ an1 pi) (* 2 h1))
- p7 (polar p (+ an1 pi) h1)
- )
- (grvecs (list col p1 p2 col p2 p3 col p3 p4 col
- p4 p5 col p5 p6 col p6 p7 col p7
- p1
- )
- )
- t
- )
- (defun _callback (dynpt / x v h w1 w2 h1 h2)
- (redraw)
- (mapcar '(lambda (x)
- (setq v (xdrx_curve_getfirstderiv e x)
- h (/ (getvar "viewsize") 80.0)
- w1 h
- w2 h
- h1 (* 2 h)
- h2 h
- )
- (XD::Pnt:ToArraw x v 252 w1 w2 h1 h2)
- )
- mids
- )
- )
- (if (setq e (xdrx_entsel
- "\n拾取曲线<退出>:"
- '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))
- )
- )
- (progn (xdrx_begin)
- (setq pt (cadr e)
- e (car e)
- segs (xdrx_getpropertyvalue e "allsegs")
- mids (mapcar '(lambda (x) (xdge::getpropertyvalue x "midpoint"))
- segs
- )
- )
- (_callback t)
- (xdrx_pointmonitor "_callback")
- (xdrx_initget "F")
- (if (setq var (getpoint "\n是否翻转方向[翻转(F)]<退出>:"))
- (progn (cond ((= var "F") (xdrx_curve_reverse e))))
- )
- (_callback t)
- (xdrx_initget)
- (xdrx_pointmonitor)
- (xdrx_end)
- )
- )
- (princ)
- )
|