马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
 - (defun c:xdtb_crvsmall (/ dist e1 e2 h p1 pmid pnt tbox txt v xdir)
- (defun _callback (dynpt)
- (redraw)
- (xdrx-grdraw 2 -1 pnt)
- (xdrx-grdraw 2 -1 (car pnt) 3 4)
- (xdrx-grdraw 2 -1 (cadr pnt) 3 4)
- (setq h (xd::doc:getpickboxheight))
- (xdrx-setpropertyvalue
- txt
- "textstring"
- (rtos (abs dist) 2 1)
- "textheight"
- h
- )
- (setq tbox (xdrx-getpropertyvalue txt "textbox")
- tbox (xd::pnts:close tbox)
- tbox (xdrx-points-offset (/ h 3.0) tbox)
- pmid (xd::geom:get9pt tbox 2)
- v (xdrx-vector-normalize (mapcar '- (cadr tbox) (car tbox)))
- )
- (xdrx-entity-align
- txt
- pmid
- v
- (mapcar '+
- (xdrx-line-midp (car pnt) (cadr pnt))
- (xdrx-vector-product
- (xdrx-vector-perpvector xdir)
- (/ h 3.0)
- )
- )
- xdir
- )
- (xd::text:adjust txt)
- (setq tbox (xdrx-getpropertyvalue txt "textbox")
- tbox (xd::pnts:close tbox)
- tbox (xdrx-points-offset (/ h 3.0) tbox)
- tbox (xd::pnts:close tbox)
- )
- (xdrx-grdraw 8 -1 tbox)
- (xdrx-grdraw 2 1 txt)
- )
- (if (and (setq e1 (car (xdrx-entsel
- "\n拾取第一条曲线<退出>:"
- '((0 . "*line,arc,ellipse,circle"))
- )
- )
- )
- (setq e2 (car (xdrx-entsel
- "\n拾取第一条曲线<退出>:"
- '((0 . "*line,arc,ellipse,circle"))
- )
- )
- )
- (setq pnt (xdrx-getpropertyvalue e1 "getclosestpointto" e2))
- )
- (progn (xdrx-begin)
- (xdrx-sysvar-push '("osmode" 0 "dimzin" 0))
- (xdrx-pointmonitor "_callback")
- (setq txt (xdrx-text-make))
- (setq
- xdir (xdrx-vector-normalize (mapcar '- (cadr pnt) (car pnt)))
- )
- (if (< (car xdir) 0.0)
- (setq xdir (xdrx-vector-negate xdir))
- )
- (xdrx-setpropertyvalue
- txt
- "textstring"
- (rtos (setq dist (apply 'distance pnt)) 2 1)
- )
- (xdrx-document-zoomcenter
- (xdrx-line-midp (car pnt) (cadr pnt))
- (* 5 dist)
- )
- (xdrx-prompt "\n两条曲线最近点距离:" dist)
- (if (setq p1 (getpoint "\n>>左键绘制标记,回车退出查看:"))
- (progn (xdrx-sysvar-push '("pdmode" 35))
- (xdrx-point-make pnt)
- (xdrx-line-make pnt)
- )
- ) (redraw)
- (xdrx-pointmonitor)
- (xdrx-sysvar-pop)
- (xdrx-end)
- )
- )
- (princ)
- )
|