[原创]：LSP函数实现自由移动。

eachy · 发表于 2003-2-20 23:32:53

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

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

×

本例仅在WCS下使用。

<normalfont>
;;矩阵应用示例一：自由移动 By Eachy 2003.02.20
;;对选择集用Vla-for每个单体即可，当然大量的实体从效率上考虑
;;就意义不大了
(defun ea:freemove (/ e urp loop urp1 source pt matrix)
(setq matrix '((1.0 0.0 0.0 0.0)
(0.0 1.0 0.0 0.0)
(0.0 0.0 1.0 0.0)
(0.0 0.0 0.0 1.0)
)
)
(setq e (car (entsel)))
(setq urp (getpoint "\n基点: ")
loop t
)
(prompt "\nscond point :")
(while loop
(setq urp1 (grread t 1 2))
(setq source (car urp1)
pt (cadr urp1)
)
(cond
((and (= source 5) ;跟踪点
(or (/= (car urp) (car pt))
(/= (cadr urp) (cadr pt))
)
)
(progn
(vla-transformby
(vlax-ename->vla-object e)
(vlax-tmatrix
(ea:matrix_SetTranslation ;构造平移矩阵－－自由移动
matrix ;如果是旋转矩阵就是自由旋转
(mapcar '- pt urp) ;矩阵乘以系数则是自由缩放
)
)
)
(setq urp pt)
)
)
((or (= source 3) ;拾取点
(and (= source 2) (or (= pt 13) (= pt 32)))
)
(setq loop nil)
)
(t)
)
)
)
</normalfont>

<normalfont> 
;;矩阵应用示例一：自由移动 By Eachy 2003.02.20 
;;对选择集用Vla-for每个单体即可，当然大量的实体从效率上考虑 
;;就意义不大了 
(defun ea:freemove (/ e urp loop urp1 source pt matrix) 
  (setq        matrix '((1.0 0.0 0.0 0.0) 
                 (0.0 1.0 0.0 0.0) 
                 (0.0 0.0 1.0 0.0) 
                 (0.0 0.0 0.0 1.0) 
                ) 
  ) 
  (setq e (car (entsel))) 
  (setq        urp  (getpoint "\n基点: ") 
        loop t 
  ) 
  (prompt "\nscond point :") 
  (while loop 
    (setq urp1 (grread t 1 2)) 
    (setq source (car urp1) 
          pt         (cadr urp1) 
    ) 
    (cond 
      ((and (= source 5)                ;跟踪点 
            (or        (/= (car urp) (car pt)) 
                (/= (cadr urp) (cadr pt)) 
            ) 
       ) 
       (progn 
         (vla-transformby 
           (vlax-ename->vla-object e) 
           (vlax-tmatrix 
             (ea:matrix_SetTranslation        ;构造平移矩阵－－自由移动 
               matrix                   ;如果是旋转矩阵就是自由旋转 
               (mapcar '- pt urp)       ;矩阵乘以系数则是自由缩放 
             ) 
           ) 
         ) 
         (setq urp pt) 
       ) 
      ) 
      ((or (= source 3)                        ;拾取点 
           (and (= source 2) (or (= pt 13) (= pt 32))) 
       ) 
       (setq loop nil) 
      ) 
      (t) 
    ) 
  ) 
) 
</normalfont>

Victorwu · 发表于 2003-2-21 02:33:20

支持原创！
运行结果如下：

freemove

选择对象:
基点:
scond point :; 错误: no function definition: VLAX-ENAME->VLA-OBJECT
[/COLOR]
请问这是怎么回事？还有，这个程序的实用意义如何？

lijiao · 发表于 2003-2-21 09:20:34

请先调用一下(vl-load-com)
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
不过请版竹完善一下就更好了。

zhynt · 发表于 2003-2-21 11:38:41

也不行：
命令: (ea:freemove)
选择对象:
基点:
scond point :; 错误: no function definition: EA:MATRIX_SETTRANSLATION
EA:MATRIX_SETTRANSLATION函数程序中未定义，是不是在你的其它程序中定义的呀。
啊，找到了：

(defun ea:matrix_SetTranslation (matrix ve / m1 m2 m3)
(setq m1 (car matrix)
m2 (cadr matrix)
m3 (nth 2 matrix)
)
(list (list (car m1) (cadr m1) (nth 2 m1) (car ve))
(list (car m2) (cadr m2) (nth 2 m2) (cadr ve))
(list (car m3) (cadr m3) (nth 2 m3) (last ve))
'(0.0 0.0 0.0 1.0)
)
)

YueFeng · 发表于 2003-2-21 12:01:41

2002版不用加VL-LOAD-COM也可以用的。

LUCAS · 发表于 2003-2-21 12:36:04

逆矩陣應用

<normalfont>
;;; By LUCAS(龙龙仔) 2003年2月18日
;;; Adds the specified item to a given block definition
;;; The drawing maybe regenerated for the change to become visible
(defun C:ADDOBJECTSTOBLOCK (/ BLK BLKDEF SSARRAY ENT DOC)
;;; Utility routine to convert a selection set to an ActiveX array
(defun SELECTIONSET->ARRAY (SS / C R)
(vl-load-com)
(setq C -1)
(repeat (sslength SS)
(setq R (cons (ssname SS (setq C (1+ C))) R))
)
(setq R (reverse R))
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length R)))
)
(mapcar 'vlax-ename->vla-object R)
)
)
;;;---------------------------------------------------------------
(defun TT (/ SS N TM)
(while (< (length (setq TM (nentselp "\n选择要加入对象的图块: ")))
4
)
)
(setq BLK (last (last TM))) ;加入最外层图块
;;(setq BLK (car (last TM))) ;only for 1:1 not mirror 加入至点选内层图块
(setq TMP (vlax-ename->vla-object BLK))
(setq TM (vlax-tmatrix
(MREV (EA:MATRIX_INVERSE
(caddr TM)
)
(* (/ 1 (vla-get-xscalefactor TMP))
(/ 1 (vla-get-yscalefactor TMP))
(/ 1 (vla-get-zscalefactor TMP))
)
)
)
)
(redraw BLK 3)
(while (not SS)
(prompt "\n选择要加入的对象: ")
(setq SS (ssget (list '(-4 . "< NOT")
(cons 2 (cdr (assoc 2 (entget BLK))))
'(-4 . "NOT >")
)
)
)
)
(setq N 0)
(repeat (sslength SS)
(vla-transformby
(vlax-ename->vla-object (ssname SS N))
TM
)
(setq N (1+ N))
)
SS
)
;;;----------------------------------------------------------------------
(defun MREV (A B / N U V)
(setq N 0)
(repeat (- (length A) 1)
(setq U (cons (mapcar '(lambda (V) (* B V)) (nth N A)) U)
N (1+ N)
)
)
(append (reverse U) (list (nth 3 A)))
)
;;;-----BY EACHY--
(defun EA:MATRIX_INVERSE (MATRIX / M0 M1 M2 M3
M00 M01 M02 M03 M10 M11
M12 M13 M20 M21 M22 M23
_A EA:DETERMINANT A11 A12
A21 A22 A33 A34 A41 A42
A43 A13 A23 A31 A32
)
;;行列式展开，计算代数余子式
(defun EA:DETERMINANT (A00 A01 A02 A10 A11 A12 A20 A21 A22 /)
(- (+ (* A00 A11 A22)
(* A01 A12 A20)
(* A02 A21 A10)
)
(* A02 A11 A20)
(* A01 A10 A22)
(* A00 A21 A12)
)
)
(setq M0 (car MATRIX)
M1 (cadr MATRIX)
M2 (nth 2 MATRIX)
M3 (last MATRIX)
)
(setq M00 (car M0)
M01 (cadr M0)
M02 (nth 2 M0)
M03 (last M0)
)
(setq M10 (car M1)
M11 (cadr M1)
M12 (nth 2 M1)
M13 (last M1)
)
(setq M20 (car M2)
M21 (cadr M2)
M22 (nth 2 M2)
M23 (last M2)
)
(setq A11 (EA:DETERMINANT M11 M12 M13 M21 M22 M23 0.0 0.0 1.0)
A12 (- (EA:DETERMINANT M10 M12 M13 M20 M22 M23 0.0 0.0 1.0))
A13 (EA:DETERMINANT M10 M11 M13 M20 M21 M23 0.0 0.0 1.0)
A21 (- (EA:DETERMINANT M01 M02 M03 M21 M22 M23 0.0 0.0 1.0))
A22 (EA:DETERMINANT M00 M02 M03 M20 M22 M23 0.0 0.0 1.0)
A23 (- (EA:DETERMINANT M00 M01 M03 M20 M21 M23 0.0 0.0 1.0))
A31 (EA:DETERMINANT M01 M02 M03 M11 M12 M13 0.0 0.0 1.0)
A32 (- (EA:DETERMINANT M00 M02 M03 M10 M12 M13 0.0 0.0 1.0))
A33 (EA:DETERMINANT M00 M01 M03 M10 M11 M13 0.0 0.0 1.0)
A41 (- (EA:DETERMINANT M01 M02 M03 M11 M12 M13 M21 M22 M23))
A42 (EA:DETERMINANT M00 M02 M03 M10 M12 M13 M20 M22 M23)
A43 (- (EA:DETERMINANT M00 M01 M03 M10 M11 M13 M20 M21 M23))
)
(list (list A11 A21 A31 A41)
(list A12 A22 A32 A42)
(list A13 A23 A33 A43)
'(0.0 0.0 0.0 1.0)
)
)
;;;-----------------------------------------------------------------------
(vl-load-com)
(setq SSARRAY (SELECTIONSET->ARRAY (TT))
BLKDEF (vla-item
(vla-get-blocks
(setq
DOC (vla-get-activedocument (vlax-get-acad-object))
)
)
(vla-get-name TMP)
)
)
(vla-copyobjects DOC SSARRAY BLKDEF)
(foreach ENT (vlax-safearray->list SSARRAY)
(vla-delete ENT)
)
(vla-regen DOC acallviewports)
(vlax-release-object DOC)
(princ)
)
</normalfont>

<normalfont> 
;;; By LUCAS(龙龙仔) 2003年2月18日 
;;; Adds the specified item to a given block definition 
;;; The drawing maybe regenerated for the change to become visible 
(defun C:ADDOBJECTSTOBLOCK (/ BLK BLKDEF SSARRAY ENT DOC) 
 
;;; Utility routine to convert a selection set to an ActiveX array 
  (defun SELECTIONSET->ARRAY (SS / C R) 
    (vl-load-com) 
    (setq C -1) 
    (repeat (sslength SS) 
      (setq R (cons (ssname SS (setq C (1+ C))) R)) 
    ) 
    (setq R (reverse R)) 
    (vlax-safearray-fill 
      (vlax-make-safearray 
        vlax-vbobject 
        (cons 0 (1- (length R))) 
      ) 
      (mapcar 'vlax-ename->vla-object R) 
    ) 
  ) 
 
;;;--------------------------------------------------------------- 
  (defun TT (/ SS N TM) 
    (while (<  (length (setq TM (nentselp "\n选择要加入对象的图块: "))) 
              4 
           ) 
    ) 
    (setq BLK (last (last TM)))  ;加入最外层图块 
    ;;(setq BLK (car (last TM))) ;only for 1:1 not mirror 加入至点选内层图块 
    (setq TMP (vlax-ename->vla-object BLK)) 
    (setq TM (vlax-tmatrix 
               (MREV (EA:MATRIX_INVERSE 
                       (caddr TM) 
                     ) 
                     (*        (/ 1 (vla-get-xscalefactor TMP)) 
                        (/ 1 (vla-get-yscalefactor TMP)) 
                        (/ 1 (vla-get-zscalefactor TMP)) 
                     ) 
               ) 
             ) 
    ) 
    (redraw BLK 3) 
    (while (not SS) 
      (prompt "\n选择要加入的对象: ") 
      (setq SS (ssget (list '(-4 . "< NOT") 
                            (cons 2 (cdr (assoc 2 (entget BLK)))) 
                            '(-4 . "NOT >") 
                      ) 
               ) 
      ) 
    ) 
    (setq N 0) 
    (repeat (sslength SS) 
      (vla-transformby 
        (vlax-ename->vla-object (ssname SS N)) 
        TM 
      ) 
      (setq N (1+ N)) 
    ) 
    SS 
  ) 
 
;;;---------------------------------------------------------------------- 
  (defun MREV (A B / N U V) 
    (setq N 0) 
    (repeat (- (length A) 1) 
      (setq U (cons (mapcar '(lambda (V) (* B V)) (nth N A)) U) 
            N (1+ N) 
      ) 
    ) 
    (append (reverse U) (list (nth 3 A))) 
  ) 
 
;;;-----BY EACHY-- 
  (defun EA:MATRIX_INVERSE (MATRIX /          M0         M1        M2     M3 
                            M00           M01          M02         M03        M10    M11 
                            M12           M13          M20         M21        M22    M23 
                            _A           EA:DETERMINANT        A11    A12 
                            A21           A22          A33         A34        A41    A42 
                            A43           A13          A23         A31        A32 
                           ) 
    ;;行列式展开，计算代数余子式 
    (defun EA:DETERMINANT (A00 A01 A02 A10 A11 A12 A20 A21 A22 /) 
      (- (+ (* A00 A11 A22) 
            (* A01 A12 A20) 
            (* A02 A21 A10) 
         ) 
         (* A02 A11 A20) 
         (* A01 A10 A22) 
         (* A00 A21 A12) 
      ) 
    ) 
    (setq M0 (car MATRIX) 
          M1 (cadr MATRIX) 
          M2 (nth 2 MATRIX) 
          M3 (last MATRIX) 
    ) 
    (setq M00 (car M0) 
          M01 (cadr M0) 
          M02 (nth 2 M0) 
          M03 (last M0) 
    ) 
    (setq M10 (car M1) 
          M11 (cadr M1) 
          M12 (nth 2 M1) 
          M13 (last M1) 
    ) 
    (setq M20 (car M2) 
          M21 (cadr M2) 
          M22 (nth 2 M2) 
          M23 (last M2) 
    ) 
    (setq A11 (EA:DETERMINANT M11 M12 M13 M21 M22 M23 0.0 0.0 1.0) 
          A12 (- (EA:DETERMINANT M10 M12 M13 M20 M22 M23 0.0 0.0 1.0)) 
          A13 (EA:DETERMINANT M10 M11 M13 M20 M21 M23 0.0 0.0 1.0) 
          A21 (- (EA:DETERMINANT M01 M02 M03 M21 M22 M23 0.0 0.0 1.0)) 
          A22 (EA:DETERMINANT M00 M02 M03 M20 M22 M23 0.0 0.0 1.0) 
          A23 (- (EA:DETERMINANT M00 M01 M03 M20 M21 M23 0.0 0.0 1.0)) 
          A31 (EA:DETERMINANT M01 M02 M03 M11 M12 M13 0.0 0.0 1.0) 
          A32 (- (EA:DETERMINANT M00 M02 M03 M10 M12 M13 0.0 0.0 1.0)) 
          A33 (EA:DETERMINANT M00 M01 M03 M10 M11 M13 0.0 0.0 1.0) 
          A41 (- (EA:DETERMINANT M01 M02 M03 M11 M12 M13 M21 M22 M23)) 
          A42 (EA:DETERMINANT M00 M02 M03 M10 M12 M13 M20 M22 M23) 
          A43 (- (EA:DETERMINANT M00 M01 M03 M10 M11 M13 M20 M21 M23)) 
 
    ) 
    (list (list A11 A21 A31 A41) 
          (list A12 A22 A32 A42) 
          (list A13 A23 A33 A43) 
          '(0.0 0.0 0.0 1.0) 
    ) 
  ) 
 
 
;;;----------------------------------------------------------------------- 
  (vl-load-com) 
  (setq        SSARRAY        (SELECTIONSET->ARRAY (TT)) 
        BLKDEF        (vla-item 
                  (vla-get-blocks 
                    (setq 
                      DOC (vla-get-activedocument (vlax-get-acad-object)) 
                    ) 
                  ) 
                  (vla-get-name TMP) 
                ) 
 
  ) 
  (vla-copyobjects DOC SSARRAY BLKDEF) 
  (foreach ENT (vlax-safearray->list SSARRAY) 
    (vla-delete ENT) 
  ) 
  (vla-regen DOC acallviewports) 
  (vlax-release-object DOC) 
  (princ) 
) 
</normalfont>

/db_自贡黄明儒_ · 发表于 2013-7-7 11:06:08

LUCAS 发表于 2003-2-21 12:36
逆矩陣應用

这个程序是不是有问题，错误在那儿呢？

/db_自贡黄明儒_ · 发表于 2013-7-7 11:45:36

03年站长就有这样的功底，今天是不是来个自定义move?

eachy · 发表于 2013-7-7 22:27:03

/db_自贡黄明儒_ 发表于 2013-7-7 11:45
03年站长就有这样的功底，今天是不是来个自定义move?

XDAPI 中提供了很多动态函数 xdrx_drag* 还有 xdrx_ssjig 、 xdrx_PointMonitor 等等，比用alisp 写好用方便

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

[原创]：LSP函数实现自由移动。

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

相关帖子

点评

点评