马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
- (defun XD::Drag:PLine (pt info swid ewid / clr dir dynpt
- msg my_err p1 p2 p3 p4 pts
- vdir
- )
- (defun my_err (msg)
- (xdrx_prompt "\n" msg)
- (xdrx_pointmonitor)
- (redraw)
- )
- (defun _callback (dynpt)
- (redraw)
- (setq dir (xdrx_vector_normalize
- (mapcar
- '-
- dynpt
- pt
- )
- )
- vdir (xdrx_vector_perpvector dir)
- p1 (mapcar
- '+
- pt
- (xdrx_vector_product vdir (- swid))
- )
- p2 (mapcar
- '+
- dynpt
- (xdrx_vector_product vdir (- ewid))
- )
- p3 (mapcar
- '+
- dynpt
- (xdrx_vector_product vdir ewid)
- )
- p4 (mapcar
- '+
- pt
- (xdrx_vector_product vdir swid)
- )
- pts (list p1 p2 p3 p4 p1)
- )
- (xdrx_grdraw clr 0 pts)
- pts
- )
- (setq *error* my_err)
- (xdrx_pointmonitor "_callback")
- (setq pt (trans pt 1 0)
- swid (* 0.5 swid)
- ewid (* 0.5 ewid)
- clr (XD::DRAG:GETCOLOR)
- )
- (if (setq p1 (getpoint pt info))
- (progn
- p1
- )
- )
- (xdrx_pointmonitor)
- (setq *error* nil)
- pts
- )
|