动态移动转换坐标

yaojing38

当前坐标系，动态移动的点怎么准确获取当前坐标，代码是论坛大佬的，有大佬帮看下？矩阵不太会。。。。移动的时候鼠标与对应点分离了。。。谢谢！

2. (defun zyyd (ent  pp1 /        
   
3.               ANGPCURSOR->PCURSOR_LAST  ;自由移动ent
   
4.        ANGSSMOVE      CODE     DISSSMOVE
   
5.        MODE             PCURSOR
   
6.        PCURSOR_LAST   PSSMOVE     PSSMOVE_LAST
   
7.        SS7        SSVLA  
   
8.       )
   
9.   (vl-load-com)
   
10.   ;(setq ent (entsel))
    
11.   (setq ss7 (ssadd) ss7 (ssadd ent ss7))
    
12.   ;(setq  P1 (cadr ent))
    
13.    ;(setq p1 (XD::Pnts:SetZ (getvar "VIEWCTR") 0)) ;3D -> 2D
    
14.   ;(setq pt1 (trans pt1 1 0))
    
15. ;;;----------------------------------------------------------------------
    
16.   (vl-cmdf "move" ss7 "" '(0 0) '(0 0))  ;使用选择集ss处于激活状态，供下面的grread使用
    
17. ;;;----------------------------------------------------------------------
    
18.   (setq PssMove_Last  pp1)
    
19.   (setq PCursor_last  (cadr (grread T 15 2))) ;PCursor_last为鼠标此时的位置，在grread中为鼠标移动时上一次的位置
    
20.   (while (and (setq mode (grread 't))
    
21.         (/= 3 (car mode))    ;若点击左键则grread中断。mode=3:鼠标左键
    
22.    )
    
23.     (setq code (car mode))
    
24.     (setq PCursor (cadr mode))
    
25. 
    
26.     (if  (and PCursor (= 5 code))  ;mode=5:鼠标移动
    
27.       (progn
    
28.   (vlax-for e      ;vlax-for:遍历对象集
    
29.         (setq    ;把选择集ss转为vla集合
    
30.           ssVla
    
31.            (vla-get-activeselectionset
    
32.           ;vla-get-activeselectionset:取得图形激活的选择集。
    
33.        (cond (*AcadDoc*)
    
34.              ((setq
    
35.           *AcadDoc* (vla-get-activedocument
    
36.           ;vla-get-activedocument:取得激活的文件（图形文件），即当前的dwg文件。
    
37.                 (vlax-get-acad-object)
    
38.           ;vlax-get-acad-object:检索当前 AutoCAD 任务中的顶层 AutoCAD应用程序对象
    
39.               )
    
40.         )
    
41.              )
    
42.        )
    
43.            )
    
44.         )
    
45.     (progn
    
46.       (setq AngPcursor->Pcursor_Last (angle Pcursor_Last Pcursor))
    
47.           ;鼠标上次位置点 至 本此位置点 的角度
    
48.       (setq AngSSMove AngPcursor->Pcursor_Last)
    
49.           ;ss要移动的方向(与P1、P2正交)(与DisSSMove配合得到方向的正反)
    
50.       (setq DisSSMove    ;ss中图元e 在本次鼠标移动时 要移动到距离
    
51.        (* (distance Pcursor_Last Pcursor)
    
52.           (cos (- AngPcursor->Pcursor_Last AngSSMove ))
    
53.           ;cos用来控制每次移动的距离大小，
    
54.           ;使得鼠标总在P1、P2连线的方向上，而不是ss与鼠标的距离越来越远难以控制。
    
55.        )
    
56.       )
    
57.       (setq PssMove (polar PssMove_Last AngSSMove DisSSMove))
    
58.           ;ss中图元e 在本次鼠标移动时 要移动到的位置点
    
59.       (vla-move e      ;移动图元e
    
60.           (vlax-3d-point PssMove_Last)
    
61.           ;vlax-3d-point:把list点表转为（变体）点表
    
62.           (vlax-3d-point PssMove)
    
63.       )
    
64.     )
    
65.   )
    
66.   (setq PCursor_Last
    
67.          PCursor
    
68.         PssMove_Last PssMove
    
69.   )
    
70.       )
    
71.     )
    
72.   )
    
73.   (princ)
    
74. )

(defun zyyd (ent  pp1 /        <br />               ANGPCURSOR->PCURSOR_LAST  ;自由移动ent<br />        ANGSSMOVE      CODE     DISSSMOVE<br />        MODE             PCURSOR<br />        PCURSOR_LAST   PSSMOVE     PSSMOVE_LAST<br />        SS7        SSVLA  <br />       )<br />   (vl-load-com)<br />   ;(setq ent (entsel))<br />   (setq ss7 (ssadd) ss7 (ssadd ent ss7))<br />   ;(setq  P1 (cadr ent))<br />    ;(setq p1 (XD::Pnts:SetZ (getvar "VIEWCTR") 0)) ;3D -> 2D<br />   ;(setq pt1 (trans pt1 1 0))<br /> ;;;----------------------------------------------------------------------<br />   (vl-cmdf "move" ss7 "" '(0 0) '(0 0))  ;使用选择集ss处于激活状态，供下面的grread使用<br /> ;;;----------------------------------------------------------------------<br />   (setq PssMove_Last  pp1)<br />   (setq PCursor_last  (cadr (grread T 15 2))) ;PCursor_last为鼠标此时的位置，在grread中为鼠标移动时上一次的位置<br />   (while (and (setq mode (grread 't))<br />         (/= 3 (car mode))    ;若点击左键则grread中断。mode=3:鼠标左键<br />    )<br />     (setq code (car mode))<br />     (setq PCursor (cadr mode))<br /> <br />     (if  (and PCursor (= 5 code))  ;mode=5:鼠标移动<br />       (progn<br />   (vlax-for e      ;vlax-for:遍历对象集<br />         (setq    ;把选择集ss转为vla集合<br />           ssVla<br />            (vla-get-activeselectionset<br />           ;vla-get-activeselectionset:取得图形激活的选择集。<br />        (cond (*AcadDoc*)<br />              ((setq<br />           *AcadDoc* (vla-get-activedocument<br />           ;vla-get-activedocument:取得激活的文件（图形文件），即当前的dwg文件。<br />                 (vlax-get-acad-object)<br />           ;vlax-get-acad-object:检索当前 <a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a> 任务中的顶层 AutoCAD应用程序对象<br />               )<br />         )<br />              )<br />        )<br />            )<br />         )<br />     (progn<br />       (setq AngPcursor->Pcursor_Last (angle Pcursor_Last Pcursor))<br />           ;鼠标上次位置点 至 本此位置点 的角度<br />       (setq AngSSMove AngPcursor->Pcursor_Last)<br />           ;ss要移动的方向(与P1、P2正交)(与DisSSMove配合得到方向的正反)<br />       (setq DisSSMove    ;ss中图元e 在本次鼠标移动时 要移动到距离<br />        (* (distance Pcursor_Last Pcursor)<br />           (cos (- AngPcursor->Pcursor_Last AngSSMove ))<br />           ;cos用来控制每次移动的距离大小，<br />           ;使得鼠标总在P1、P2连线的方向上，而不是ss与鼠标的距离越来越远难以控制。<br />        )<br />       )<br />       (setq PssMove (polar PssMove_Last AngSSMove DisSSMove))<br />           ;ss中图元e 在本次鼠标移动时 要移动到的位置点<br />       (vla-move e      ;移动图元e<br />           (vlax-3d-point PssMove_Last)<br />           ;vlax-3d-point:把list点表转为（变体）点表<br />           (vlax-3d-point PssMove)<br />       )<br />     )<br />   )<br />   (setq PCursor_Last<br />          PCursor<br />         PssMove_Last PssMove<br />   )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

飞雪神光

乱七八糟的

yaojing38

飞雪神光 发表于 2023-5-4 19:36
乱七八糟的

说的不是很明白，，就是用户坐标系，获取鼠标的准确世界坐标系点位置，动态获取，动态转换成世界坐标位置。。。。 不转换移动物体的时候，物体跟鼠标点的位置会偏离。。。

飞雪神光

1. (defun zyyd (ent / code e gr loop pt pt0 ty)
   
2.   (vl-load-com)
   
3.   (setq ty(car ent))
   
4.   (setq pt0(cadr ent))
   
5.   (setq e(vlax-ename->vla-object ty))
   
6.   (setq loop t)
   
7.   (while loop
   
8.     (setq gr (grread t 15 0))
   
9.     (setq pt (cadr gr))
   
10.     (cond
    
11.       ((= 5 (car gr))
    
12.         (vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))
    
13.         (setq pt0 pt)
    
14.       )
    
15.       ((or (= 3 (car gr)) (= 32 (cadr gr)))
    
16.         (setq loop nil)
    
17.       )
    
18.     )
    
19.   )
    
20.   (princ)
    
21. )
    
22. (zyyd (entsel))

(defun zyyd (ent / code e gr loop pt pt0 ty)<br />   (vl-load-com)<br />   (setq ty(car ent))<br />   (setq pt0(cadr ent))<br />   (setq e(vlax-ename->vla-object ty))<br />   (setq loop t)<br />   (while loop<br />     (setq gr (grread t 15 0))<br />     (setq pt (cadr gr))<br />     (cond <br />       ((= 5 (car gr))<br />         (vla-move e (vlax-3d-point pt0)(vlax-3d-point pt))<br />         (setq pt0 pt)<br />       )<br />       ((or (= 3 (car gr)) (= 32 (cadr gr)))<br />         (setq loop nil)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> (zyyd (entsel))

用户坐标系就很麻烦 不可以先转成世界坐标吗 试试这个不用command的  你是不是视图不是俯视啊

yaojing38

飞雪神光 发表于 2023-5-4 20:23
用户坐标系就很麻烦 不可以先转成世界坐标吗 试试这个不用command的  你是不是视图不是俯视啊

是俯视视图，谢谢您！可以用了。。。我加上了转换，，，(setq pt (trans (cadr gr) 1 0))，可能我的有距离的问题吧。。。