[求助]：关于在VLisp中实现拖动效果的方法！

lcl2094_cn · 发表于 2002-9-25 20:39:58

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

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

×

请教函数“Grread”的有效用法！最好是有例程！我个人感觉没有什么用处，在使用这个函数时，无法使用已经打开的捕捉和不能交互的使用拖动……
　　　　　　　　　　　　　　　　　谢谢！

XDSoft · 发表于 2002-9-25 20:55:14

最初由 lcl2094_cn 发布
[B]请教函数“Grread”的有效用法！最好是有例程！我个人感觉没有什么用处，在使用这个函数时，无法使用已经打开的捕捉和不能交互的使用拖动……
　　　　　　　　　　　　　　　　　谢谢！ [/B]

在LISP里面只能使用GRREAD，里面调用GRDRAW画简单的直线向量，效果确实不太好。

ADSRX可以使用ads_draggen函数，可以拖动选择集，功能又强大了点，但是缺点是不能使用2000+以后的“极轴追踪”

最好的方法是ARX的AcEdJig类，可以做ACAD里面的任何拖动，大家看到过的所有拖动方法都可以实现，他可以直接使用AcGiWordDraw绘制低级的矢量原子，包括线，射线，POLY，圆，弧等等，也可以直接使用实体自身的worldDraw()方法显示实体自身。

如果你使用LISP，推荐你使用XDRX_API，里面的xdrx_Pickset_DragGen可以实现非常强大的功能（把AcEdJig类包装成提供LISP调用的函数），具体实例可以看“晓东工具箱”里面“自由缩放”，“自由拷贝”、“自由粘贴”，“自由缩放”的LISP程序。

把这个函数和API里面关于“矩阵”的方法结合使用，可以让LISP程序员体会到ARX开发的强大功能。

lcl2094_cn · 发表于 2002-9-26 20:14:18

谢谢你告诉我这些。可我只会Lisp，慢慢努力了！

XDSoft · 发表于 2002-9-26 20:25:20

最初由 lcl2094_cn 发布
[B]谢谢你告诉我这些。可我只会Lisp，慢慢努力了！ [/B]

XDRX_API就是一组供LISP使用的外部函数（和你使用标准的LISP函数一样）。

你可以看看“晓东工具箱”，都是用LISP写成的。

god · 发表于 2002-9-27 11:26:53

就怕用你的XDRX_API编好程序后，过期就不能用了。虽然XDRX_API功能多，还是不敢用。

前生 · 发表于 2002-9-27 12:11:53

呵呵/善哉

XDSoft · 发表于 2002-9-27 17:13:41

最初由 god 发布
[B]就怕用你的XDRX_API编好程序后，过期就不能用了。虽然XDRX_API功能多，还是不敢用。 [/B]

呵呵，XDRX_API早就不过期了。两年前就有人这么说，可能5年后还会有人这么说。

晓东工具箱准备全面启用OBJECTDCL作对话框。能替自己省事的地方要学会省事。多多交流，什么都可以解决的。

eachy · 发表于 2002-9-27 18:52:14

最初由 god 发布
[B]就怕用你的XDRX_API编好程序后，过期就不能用了。虽然XDRX_API功能多，还是不敢用。 [/B]

将日期调至3000年试试API能加载吗？把结果贴上来吧。

god · 发表于 2002-9-27 19:03:29

可以用，倒是autocad2002不行，要在2037年前才行

XDSoft · 发表于 2002-9-27 20:59:14

下面是“晓东工具箱”里面的动态拖动－自由拷贝、自由移动、自由粘贴使用XDRX_API的实现代码，改程序集成在“通用LISP函数”XDLSP.LSP文件中。

除了拖动，大家还可以探讨下“矩阵运算”在ACAD里面的应用。

[FONT=courier new]
(defun $xdlsp_dragm (ss pj tf / box prompt1 pj pj1 tf1 mRMatrix mRMatrix1
mRMatrix2 mMatTrans mMatTrans1 mMatRot ang pt1 pt2
pt3 pt4 mVec1 mVec2
)
(xdrx_SysVar_Push "osmode" "CURSORSIZE")
(xdrx_begin)
(xdrx_ucson)
(setvar "osmode" 545)
(setvar "CURSORSIZE" 5)
(if (not pj)
(progn
(setq box (xdrx_entity_box ss)
pj (car box)
)
)
)
(setq prompt1 "\n点取位置或 {改基点[T]/改转角[R]/转90度[A]/镜像[M]/左右翻[S]/上下翻[D]/缩放[L]/对齐[F]/}<退出>:"
mRMatrix t
tf1 t
mTMatrix0 (xdrx_matrix_identity 3)
mRMatrix t
)
(xdrx_drag_setmatrix mTMatrix0 t)
(while mRMatrix
(xdrx_drag_initget 1 "T R A M S D L F")
(xdrx_drag_setmode "Move")
(setq mRMatrix (xdrx_PickSet_dragGen prompt1 ss pj 1 (not tf)))
(cond
((= mRMatrix "A")
(setq mTMatrix (xdrx_matrix_setRotation mTMatrix0 (/ pi 2) '
(0 0 1) (trans pj 1 0)
)
)
(xdrx_drag_setmatrix mTMatrix nil)
)
((= mRMatrix "S")
(setq mTMatrix (xdrx_matrix_setMirror mTMatrix0 (list
(trans pj 1 0)
(trans
(polar pj
(/ pi 2) 100
) 1 0
)
)
)
)
(xdrx_drag_setmatrix mTMatrix nil)
)
((= mRMatrix "D")
(setq mTMatrix (xdrx_matrix_setMirror mTMatrix0 (list
(trans pj 1 0)
(trans
(polar pj 0.0 100)
1 0
)
)
)
)
(xdrx_drag_setmatrix mTMatrix nil)
)
((= mRMatrix "F")
(setq mTMatrix2 (xdrx_drag_getLastMatrix))
(xdrx_setmark)
($xdlsp_Pickset_TransFormedCopy ss mTMatrix2)
(if (and
(setq pt1 (getpoint "\n请拾取对齐源参考点:"))
(setq pt2 (getpoint pt1 "\n请拾取另一定确定对齐参考轴:"))
(setq pt3 (getpoint "\n请拾取目标参考点:"))
(setq pt4 (getpoint pt3 "\n请拾取另一点确定目标参考轴:"))
)
(progn
(setq mVec1 (mapcar
'-
pt1
pt2
)
mVec2 (mapcar
'-
pt3
pt4
)
ang (xdrx_vector_angle mVec1 mVec2)
mMatTrans (xdrx_matrix_setTranslation mTMatrix0
(mapcar
'-
'(0 0 0)
(trans pj 1 0)
)
)
mMatTrans1 (xdrx_matrix_setTranslation mTMatrix0
(mapcar
'-
(trans pj 1 0)
'(0 0 0)
)
)
mMatRot (xdrx_vector_rotateTo mVec1 mVec2)
mMatRot (xdrx_matrix_setTranslation mMatRot
(mapcar
'-
pt3
pt1
)
)
mMatRot (xdrx_matrix_product mMatTrans1
(xdrx_matrix_product mMatRot mMatTrans)
)
)
(xdrx_drag_setmatrix mMatRot nil)
)
)
(command "._erase" (xdrx_getss) "")
)
((= mRMatrix "R")
(setq mTMatrix2 (xdrx_drag_getLastMatrix))
(xdrx_setmark)
($xdlsp_Pickset_TransFormedCopy ss mTMatrix2)
($xdlsp_PickSet_redraw (setq ss1 (xdrx_getss))
3
)
(xdrx_drag_setmatrix mTMatrix0 t)
(xdrx_drag_SetMode "Rotate")
(xdrx_drag_initget 1)
(if (not (setq mTMatrix (xdrx_pickset_draggen "\n旋转角度[回车输入]:"
ss1 (setq pj1
(trans (xdrx_drag_getLastPoint) 0 1)
)
2
)
)
)
(progn
(if (not (setq ang (getangle "\n请输入旋转角度<0>:")))
(setq ang 0.0)
)
(setq mTMatrix (xdrx_matrix_setRotation mTMatrix0 ang '
(0 0 1) (trans pj1 1 0)
)
)
)
(progn
(setq mMatTrans (xdrx_matrix_setTranslation mTMatrix0
(mapcar
'-
pj
pj1
)
)
mTMatrix (xdrx_matrix_product mMatTrans mTMatrix)
mTMatrix (xdrx_matrix_product mTMatrix mTMatrix2)
)
)
)
(xdrx_drag_setmatrix mTMatrix t)
(command "._erase" ss1 "")
)
((= mRMatrix "M")
(setq mTMatrix2 (xdrx_drag_getLastMatrix))
(xdrx_setmark)
($xdlsp_Pickset_TransFormedCopy ss mTMatrix2)
($xdlsp_PickSet_redraw (setq ss1 (xdrx_getss))
3
)
(xdrx_drag_setmatrix mTMatrix0 t)
(xdrx_drag_SetMode "Mirror")
(xdrx_drag_initget 1)
(if (and
(setq pj1 (getpoint "\n请拾取镜像参考基点<退出>:"))
(setq mTMatrix (xdrx_pickset_draggen "\n\n请拾取另一点定确定镜像轴<退出>:"
ss1 pj1 2
)
)
)
(progn
(setq mMatTrans (xdrx_matrix_setTranslation mTMatrix0
(mapcar
'-
pj
pj1
)
)
mTMatrix (xdrx_matrix_product mMatTrans mTMatrix)
mTMatrix (xdrx_matrix_product mTMatrix mTMatrix2)
)
)
(progn
(setq mTMatrix mTMatrix2)
)
)
(xdrx_drag_setmatrix mTMatrix nil)
(command "._erase" ss1 "")
)
((= mRMatrix "L")
(setq mTMatrix2 (xdrx_drag_getLastMatrix))
(xdrx_setmark)
($xdlsp_Pickset_TransFormedCopy ss mTMatrix2)
($xdlsp_PickSet_redraw (setq ss1 (xdrx_getss))
3
)
(xdrx_drag_setmatrix mTMatrix0 t)
(setq box (xdrx_entity_box ss1)
scl (- (caadr box) (caar box))
)
(xdrx_drag_SetMode "Scale" scl)
(xdrx_drag_initget 1)
(if (not (setq mTMatrix (xdrx_pickset_draggen "\n缩放比例[回车输入]:"
ss1 (setq pj1
(trans (xdrx_drag_getLastPoint) 0 1)
)
2
)
)
)
(progn
(initget 6)
(if (not (setq scl (getreal "\n请输入缩放比例<1>:")))
(setq scl 1.0)
)
(if (/= scl 1.0)
(progn
(setq mTMatrix (xdrx_matrix_setScale mTMatrix0 scl
(trans pj1 1 0)
)
)
)
)
)
)
(setq mMatTrans (xdrx_matrix_setTranslation mTMatrix0
(mapcar
'-
pj
pj1
)
)
mTMatrix (xdrx_matrix_product mMatTrans mTMatrix)
mTMatrix (xdrx_matrix_product mTMatrix mTMatrix2)
)
(xdrx_drag_setmatrix mTMatrix nil)
(command "._erase" ss1 "")
)
((= mRMatrix "T")
(setq mTMatrix2 (xdrx_drag_getLastMatrix))
(xdrx_setmark)
($xdlsp_Pickset_TransFormedCopy ss mTMatrix2)
(if (not tf)
($xdlsp_pickset_visible ss tf)
)
(initget 2)
(if (setq pj1 (getpoint "\n请输入新的基点:"))
(progn
(setq pj pj1)
(xdrx_drag_setmatrix mTMatrix2 T)
)
)
(command "._erase" (xdrx_getss) "")
)
((= (type mRMatrix) 'LIST)
(if tf
($xdlsp_Pickset_TransFormedCopy ss mRMatrix)
(progn
($xdlsp_Pickset_TransForm ss mRMatrix)
(setq mRMatrix nil)
)
)
)
)
)
(xdrx_ucsoff)
(xdrx_end)
(xdrx_SysVar_Pop)
(princ)
)
[/FONT]

[FONT=courier new] 
(defun $xdlsp_dragm (ss pj tf / box prompt1 pj pj1 tf1 mRMatrix mRMatrix1 
                        mRMatrix2 mMatTrans mMatTrans1 mMatRot ang pt1 pt2 
                        pt3 pt4 mVec1 mVec2 
                    ) 
  (xdrx_SysVar_Push "osmode" "CURSORSIZE") 
  (xdrx_begin) 
  (xdrx_ucson) 
  (setvar "osmode" 545) 
  (setvar "CURSORSIZE" 5) 
  (if (not pj) 
    (progn 
      (setq box (xdrx_entity_box ss) 
            pj (car box) 
      ) 
    ) 
  ) 
  (setq prompt1 "\n点取位置或 {改基点[T]/改转角[R]/转90度[A]/镜像[M]/左右翻[S]/上下翻[D]/缩放[L]/对齐[F]/}<退出>:" 
        mRMatrix t 
        tf1 t 
        mTMatrix0 (xdrx_matrix_identity 3) 
        mRMatrix t 
  ) 
  (xdrx_drag_setmatrix mTMatrix0 t) 
  (while mRMatrix 
    (xdrx_drag_initget 1 "T R A M S D L F") 
    (xdrx_drag_setmode "Move") 
    (setq mRMatrix (xdrx_PickSet_dragGen prompt1 ss pj 1 (not tf))) 
    (cond 
      ((= mRMatrix "A") 
        (setq mTMatrix (xdrx_matrix_setRotation mTMatrix0 (/ pi 2) ' 
                                                (0 0 1) (trans pj 1 0) 
                       ) 
        ) 
        (xdrx_drag_setmatrix mTMatrix nil) 
      ) 
      ((= mRMatrix "S") 
        (setq mTMatrix (xdrx_matrix_setMirror mTMatrix0 (list 
                                                              (trans pj 1 0) 
                                                              (trans 
                                                                     (polar pj 
                                                                            (/ pi 2) 100 
                                                                     ) 1 0 
                                                              ) 
                                                        ) 
                       ) 
        ) 
        (xdrx_drag_setmatrix mTMatrix nil) 
      ) 
      ((= mRMatrix "D") 
        (setq mTMatrix (xdrx_matrix_setMirror mTMatrix0 (list 
                                                              (trans pj 1 0) 
                                                              (trans 
                                                                     (polar pj 0.0 100) 
                                                                     1 0 
                                                              ) 
                                                        ) 
                       ) 
        ) 
        (xdrx_drag_setmatrix mTMatrix nil) 
      ) 
      ((= mRMatrix "F") 
        (setq mTMatrix2 (xdrx_drag_getLastMatrix)) 
        (xdrx_setmark) 
        ($xdlsp_Pickset_TransFormedCopy ss mTMatrix2) 
        (if (and 
              (setq pt1 (getpoint "\n请拾取对齐源参考点:")) 
              (setq pt2 (getpoint pt1 "\n请拾取另一定确定对齐参考轴:")) 
              (setq pt3 (getpoint "\n请拾取目标参考点:")) 
              (setq pt4 (getpoint pt3 "\n请拾取另一点确定目标参考轴:")) 
            ) 
          (progn 
            (setq mVec1 (mapcar 
                          '- 
                          pt1 
                          pt2 
                        ) 
                  mVec2 (mapcar 
                          '- 
                          pt3 
                          pt4 
                        ) 
                  ang (xdrx_vector_angle mVec1 mVec2) 
                  mMatTrans (xdrx_matrix_setTranslation mTMatrix0 
                                                        (mapcar 
                                                          '- 
                                                          '(0 0 0) 
                                                          (trans pj 1 0) 
                                                        ) 
                            ) 
                  mMatTrans1 (xdrx_matrix_setTranslation mTMatrix0 
                                                         (mapcar 
                                                           '- 
                                                           (trans pj 1 0) 
                                                           '(0 0 0) 
                                                         ) 
                             ) 
                  mMatRot (xdrx_vector_rotateTo mVec1 mVec2) 
                  mMatRot (xdrx_matrix_setTranslation mMatRot 
                                                      (mapcar 
                                                        '- 
                                                        pt3 
                                                        pt1 
                                                      ) 
                          ) 
                  mMatRot (xdrx_matrix_product mMatTrans1 
                                               (xdrx_matrix_product mMatRot mMatTrans) 
                          ) 
            ) 
            (xdrx_drag_setmatrix mMatRot nil) 
          ) 
        ) 
        (command "._erase" (xdrx_getss) "") 
      ) 
      ((= mRMatrix "R") 
        (setq mTMatrix2 (xdrx_drag_getLastMatrix)) 
        (xdrx_setmark) 
        ($xdlsp_Pickset_TransFormedCopy ss mTMatrix2) 
        ($xdlsp_PickSet_redraw (setq ss1 (xdrx_getss)) 
                               3 
        ) 
        (xdrx_drag_setmatrix mTMatrix0 t) 
        (xdrx_drag_SetMode "Rotate") 
        (xdrx_drag_initget 1) 
        (if (not (setq mTMatrix (xdrx_pickset_draggen "\n旋转角度[回车输入]:" 
                                                      ss1 (setq pj1 
                                                                (trans (xdrx_drag_getLastPoint) 0 1) 
                                                          ) 
                                                      2 
                                ) 
                 ) 
            ) 
          (progn 
            (if (not (setq ang (getangle "\n请输入旋转角度<0>:"))) 
              (setq ang 0.0) 
            ) 
            (setq mTMatrix (xdrx_matrix_setRotation mTMatrix0 ang ' 
                                                    (0 0 1) (trans pj1 1 0) 
                           ) 
            ) 
          ) 
          (progn 
            (setq mMatTrans (xdrx_matrix_setTranslation mTMatrix0 
                                                        (mapcar 
                                                          '- 
                                                          pj 
                                                          pj1 
                                                        ) 
                            ) 
                  mTMatrix (xdrx_matrix_product mMatTrans mTMatrix) 
                  mTMatrix (xdrx_matrix_product mTMatrix mTMatrix2) 
            ) 
          ) 
        ) 
        (xdrx_drag_setmatrix mTMatrix t) 
        (command "._erase" ss1 "") 
      ) 
      ((= mRMatrix "M") 
        (setq mTMatrix2 (xdrx_drag_getLastMatrix)) 
        (xdrx_setmark) 
        ($xdlsp_Pickset_TransFormedCopy ss mTMatrix2) 
        ($xdlsp_PickSet_redraw (setq ss1 (xdrx_getss)) 
                               3 
        ) 
        (xdrx_drag_setmatrix mTMatrix0 t) 
        (xdrx_drag_SetMode "Mirror") 
        (xdrx_drag_initget 1) 
        (if (and 
              (setq pj1 (getpoint "\n请拾取镜像参考基点<退出>:")) 
              (setq mTMatrix (xdrx_pickset_draggen "\n\n请拾取另一点定确定镜像轴<退出>:" 
                                                   ss1 pj1 2 
                             ) 
              ) 
            ) 
          (progn 
            (setq mMatTrans (xdrx_matrix_setTranslation mTMatrix0 
                                                        (mapcar 
                                                          '- 
                                                          pj 
                                                          pj1 
                                                        ) 
                            ) 
                  mTMatrix (xdrx_matrix_product mMatTrans mTMatrix) 
                  mTMatrix (xdrx_matrix_product mTMatrix mTMatrix2) 
            ) 
          ) 
          (progn 
            (setq mTMatrix mTMatrix2) 
          ) 
        ) 
        (xdrx_drag_setmatrix mTMatrix nil) 
        (command "._erase" ss1 "") 
      ) 
      ((= mRMatrix "L") 
        (setq mTMatrix2 (xdrx_drag_getLastMatrix)) 
        (xdrx_setmark) 
        ($xdlsp_Pickset_TransFormedCopy ss mTMatrix2) 
        ($xdlsp_PickSet_redraw (setq ss1 (xdrx_getss)) 
                               3 
        ) 
        (xdrx_drag_setmatrix mTMatrix0 t) 
        (setq box (xdrx_entity_box ss1) 
              scl (- (caadr box) (caar box)) 
        ) 
        (xdrx_drag_SetMode "Scale" scl) 
        (xdrx_drag_initget 1) 
        (if (not (setq mTMatrix (xdrx_pickset_draggen "\n缩放比例[回车输入]:" 
                                                      ss1 (setq pj1 
                                                                (trans (xdrx_drag_getLastPoint) 0 1) 
                                                          ) 
                                                      2 
                                ) 
                 ) 
            ) 
          (progn 
            (initget 6) 
            (if (not (setq scl (getreal "\n请输入缩放比例<1>:"))) 
              (setq scl 1.0) 
            ) 
            (if (/= scl 1.0) 
              (progn 
                (setq mTMatrix (xdrx_matrix_setScale mTMatrix0 scl 
                                                     (trans pj1 1 0) 
                               ) 
                ) 
              ) 
            ) 
          ) 
        ) 
        (setq mMatTrans (xdrx_matrix_setTranslation mTMatrix0 
                                                    (mapcar 
                                                      '- 
                                                      pj 
                                                      pj1 
                                                    ) 
                        ) 
              mTMatrix (xdrx_matrix_product mMatTrans mTMatrix) 
              mTMatrix (xdrx_matrix_product mTMatrix mTMatrix2) 
        ) 
        (xdrx_drag_setmatrix mTMatrix nil) 
        (command "._erase" ss1 "") 
      ) 
      ((= mRMatrix "T") 
        (setq mTMatrix2 (xdrx_drag_getLastMatrix)) 
        (xdrx_setmark) 
        ($xdlsp_Pickset_TransFormedCopy ss mTMatrix2) 
        (if (not tf) 
          ($xdlsp_pickset_visible ss tf) 
        ) 
        (initget 2) 
        (if (setq pj1 (getpoint "\n请输入新的基点:")) 
          (progn 
            (setq pj pj1) 
            (xdrx_drag_setmatrix mTMatrix2 T) 
          ) 
        ) 
        (command "._erase" (xdrx_getss) "") 
      ) 
      ((= (type mRMatrix) 'LIST) 
        (if tf 
          ($xdlsp_Pickset_TransFormedCopy ss mRMatrix) 
          (progn 
            ($xdlsp_Pickset_TransForm ss mRMatrix) 
            (setq mRMatrix nil) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (xdrx_SysVar_Pop) 
  (princ) 
) 
[/FONT]

Qlin · 发表于 2002-10-9 01:37:29

最初由 XDSoft 发布
[B]
晓东工具箱准备全面启用OBJECTDCL作对话框。
能替自己省事的地方要学会省事。多多交流，
什么都可以解决的。
[/B]

OBJECTDCL我也心痒了好久了，
就是一直找不到能用的版本。

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

[求助] [求助]：关于在VLisp中实现拖动效果的方法！

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

相关帖子

Re: [求助]：关于在VLisp中实现拖动效果的方法！

谢谢你告诉我这些。可我只会Lisp，慢慢努力了！

Re: 谢谢你告诉我这些。可我只会Lisp，慢慢努力了！

“自由拷贝、自由移动、自由粘贴”的LISP代码...