(XD::Drag:DLine)双线拖动实现函数

Lispboy · 发表于 2013-7-23 00:45:25

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

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

×

;|
双线拖动实现函数
参数：
info --- 提示字符串
pj ---- 基点
w1 --- 左墙厚
w2 ---- 右墙厚
offset-dist --- 基点偏移距离（相对基点）
keyword ---- 关键字
返回：
-1 -- 回车
-4 -- ESC
(左线实体右线实体) -- 双线实体名
|;
(defun XD::Drag:DLine (info pj w1 w2 offset-dist keyword / dynpt e1 e2 ll p1 p2 pd-1 pd-2 pts pu-1 pu-2 ret v vd vo vp vu x)
(defun DLineCallBack (dynPt / pts entl)
(setq p1 pj
p2 dynPt
v (mapcar '- p2 pj)
vp (xdrx_vector_normalize (xdrx_vector_perpVector v))
vo (xdrx_vector_product vp (- offset-dist))
vu (xdrx_vector_product vp w1)
pu-1 (mapcar '+ p1 vu)
pu-2 (mapcar '+ p2 vu)
vd (xdrx_vector_product vp (- w2))
pd-1 (mapcar '+ p1 vd)
pd-2 (mapcar '+ p2 vd)
)
(setq ll (mapcar '(lambda(x)(mapcar '+ x vo))(list pu-1 pu-2 pd-1 pd-2)))
(XD::Obj:EntMod e1 (list 10 (car ll) 11 (cadr ll)))
(XD::Obj:EntMod e2 (list 10 (nth 2 ll) 11 (nth 3 ll)))
)
(setq pj (trans pj 1 0))
(setvar "lastPoint" pj)
(initget 1)
(xdrx_line_make pj pj)
(setq e1 (entlast))
(xdrx_line_make pj pj)
(setq e2 (entlast))
(setq ret (xdrx_drag_jig "DLineCallBack" info keyWord (+ 1 2 4 8 16 128 512 65536) 2 pj))
(if (/= (type ret) 'LIST)
(progn
(entdel e1)
(entdel e2)
)
(setq ret (list e1 e2))
)
(gc)
ret
)

;| 
双线拖动实现函数 
 
参数： 
   info --- 提示字符串 
   pj ----  基点 
   w1 ---   左墙厚 
   w2 ----  右墙厚 
   offset-dist --- 基点偏移距离（相对基点） 
   keyword ---- 关键字 
 
返回： 
   -1 -- 回车 
   -4 -- ESC 
   (左线实体 右线实体) -- 双线实体名 
|; 
(defun XD::Drag:DLine (info pj w1 w2 offset-dist keyword / dynpt e1 e2 ll p1 p2 pd-1 pd-2 pts pu-1 pu-2 ret v vd vo vp vu x) 
  (defun DLineCallBack (dynPt / pts entl) 
    (setq p1 pj 
          p2 dynPt 
          v (mapcar '-  p2 pj) 
          vp (xdrx_vector_normalize (xdrx_vector_perpVector v)) 
          vo (xdrx_vector_product vp (- offset-dist)) 
          vu (xdrx_vector_product vp w1) 
          pu-1 (mapcar '+ p1 vu) 
          pu-2 (mapcar '+ p2 vu) 
          vd (xdrx_vector_product vp (- w2)) 
          pd-1 (mapcar '+ p1 vd) 
          pd-2 (mapcar '+ p2 vd)          
    ) 
    (setq ll (mapcar '(lambda(x)(mapcar '+ x vo))(list pu-1 pu-2 pd-1 pd-2))) 
    (XD::Obj:EntMod e1 (list 10 (car ll) 11 (cadr ll))) 
    (XD::Obj:EntMod e2 (list 10 (nth 2 ll) 11 (nth 3 ll))) 
  ) 
 
  (setq pj (trans pj 1 0)) 
  (setvar "lastPoint" pj) 
  (initget 1) 
  (xdrx_line_make pj pj) 
  (setq e1 (entlast)) 
  (xdrx_line_make pj pj) 
  (setq e2 (entlast)) 
  (setq ret (xdrx_drag_jig "DLineCallBack" info keyWord (+ 1 2 4 8 16 128 512 65536) 2 pj)) 
 
  (if (/= (type ret) 'LIST) 
        (progn 
          (entdel e1) 
          (entdel e2) 
        ) 
        (setq ret (list e1 e2)) 
  ) 
  (gc) 
  ret 
)

liuyj · 发表于 2013-8-11 10:34:18

加载了最新的API后，程序运行时出现错误。命令行显示：
(XD::drag:dLine "\nstart" (getpoint) 400 400 0 "")
start; 错误: *error* 函数中出错ADS 请求被拒绝
; 错误: 参数类型错误: listp <图元名: 7eb0cac0>

XDSoft · 发表于 2013-8-11 13:20:09

liuyj 发表于 2013-8-11 10:34
加载了最新的API后，程序运行时出现错误。命令行显示：
(XD::drag:dLine "\nstart" (getpoint) 400 400 0 ...

谢谢！等下版API解决。

liuyj · 发表于 2013-8-26 12:58:15

加载最新的API和函数库，没有问题了。但是加载上面的源码，问题还是存在，是不是源码已有更新？能不能重新贴一下？

XDSoft · 发表于 2013-8-27 03:12:40

liuyj 发表于 2013-8-26 12:58
加载最新的API和函数库，没有问题了。但是加载上面的源码，问题还是存在，是不是源码已有更新？能不能重新 ...

以后遇到啥问题，把提示给贴出来，方便查找原因。

2008下，测试了代码，正常，可以拖动双线，没有问题。

论坛所有代码，请一定加载XDRX API和晓东通用LISP函数库最新版本。

st788796 · 发表于 2013-8-27 05:55:07

这些回调用entmod方法还能实现同步，如果是transform有不同步现象，不得其解，或许数据库更新异步来自: Android客户端

cooolsee · 发表于 2014-5-8 22:29:01

努力的要求自己的进步

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

[拖动] (XD::Drag:DLine)双线拖动实现函数

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

相关帖子

点评

评分

点评