[测试]：XDAPI矩阵应用示例之自由缩放旋转。

eachy · 发表于 2003-2-21 23:48:10

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

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

×

;;矩阵应用示例一：自由旋转缩放 By Eachy 2003.02.20
(defun ea:drma (/ e v1 v2 matrix pt0 urp loop urp1 source pt matrix)
(setq e (xdrx_entsel "\n选择线: " '((0 . "LINE")))
urp (xdrx_getentdxf 10)
loop t
)
(setq
matrix (xdrx_matrix_SetTranslation (xdrx_matrix_identity 3) urp)
)
(setq v1 (distance urp (setq pt0 (xdrx_getentdxf 11))))
(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
(setq v2 (distance pt urp))
(xdrx_entity_transform
e
(xdrx_matrix_setrotation
(xdrx_matrix_setScale
matrix
(/ v2 v1)
urp
)
(xdrx_vector_angle (mapcar '- pt0 urp) (mapcar '- pt urp))
'(0.0 0.0 1.0)
urp
)
)
(setq v1 v2
pt0 pt
)
;;(setq urp pt)
)
)
((or (= source 3) ;拾取点
(and (= source 2) (or (= pt 13) (= pt 32)))
)
(setq loop nil)
)
(t)
)
)
)

;;矩阵应用示例一：自由旋转缩放 By Eachy 2003.02.20 
 
(defun ea:drma (/ e v1 v2 matrix pt0 urp loop urp1 source pt matrix) 
  (setq        e    (xdrx_entsel "\n选择线: " '((0 . "LINE"))) 
        urp  (xdrx_getentdxf 10) 
        loop t 
  ) 
  (setq 
    matrix (xdrx_matrix_SetTranslation (xdrx_matrix_identity 3) urp) 
  ) 
  (setq v1 (distance urp (setq pt0 (xdrx_getentdxf 11)))) 
  (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 
         (setq v2 (distance pt urp)) 
         (xdrx_entity_transform 
           e 
           (xdrx_matrix_setrotation 
             (xdrx_matrix_setScale 
               matrix 
               (/ v2 v1) 
               urp 
             ) 
             (xdrx_vector_angle (mapcar '- pt0 urp) (mapcar '- pt urp)) 
             '(0.0 0.0 1.0) 
             urp 
           ) 
         ) 
         (setq v1  v2 
               pt0 pt 
         ) 
         ;;(setq urp pt) 
       ) 
      ) 
      ((or (= source 3)                        ;拾取点 
           (and (= source 2) (or (= pt 13) (= pt 32))) 
       ) 
       (setq loop nil) 
      ) 
      (t) 
    ) 
  ) 
)

XDSoft · 发表于 2003-2-21 23:57:33

最初由 eachy 发布
[B][CODE]
;;矩阵应用示例一：自由旋转缩放 By Eachy 2003.02.20

(defun ea:drma (/ e v1 v2 matrix pt0 urp loop urp1 source pt matrix)
(setq e (xdrx_entsel "\n选择线: " '((0 . "LINE")))
urp (xdrx... [/B]

使用GRREAD拖动实体要进行实体变换，重生成，速度要慢。拖动方面的应用还是用实体自身的worldDraw，实体显示自身到屏幕的方法效率更高。还是用 xdrx_pickset_dragGen 更好。

eachy · 发表于 2003-2-22 00:29:56

只是试试VLSP下拖动的方法，当然是对简单实体。如果是一根线或者一个简单块的拖动，毫秒级差别可以忽略不计，毕竟搞设计不差几秒的。

LUCAS · 发表于 2003-2-24 13:30:31

;;不用XDAPI的话旋转转换矩阵要如何建立???

;;实现动态缩放。
(defun LAI:FREEMAG (/ HOLDECHO OLD_ERROR E EE URP LOOP URP1 URP2 SOURCE
PT SCALE)
(defun ERR (MSG)
(if (or (= MSG "Function cancelled")
(= MSG "quit / exit abort")
)
(princ)
(princ (strcat "\nError: " MSG))
)
(command "_.ERASE" E "")
(redraw)
(redraw EE 4)
(if OLD_ERROR
(setq *ERROR* OLD_ERROR)
)
(princ)
)
(setq HOLDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq OLD_ERROR *ERROR*)
(setq *ERROR* ERR)
(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 EE (car (entsel)))
(command "_.COPY" EE "" "0,0" "@")
(setq E (entlast))
(setq URP (getpoint "\n指定基准点: ")
LOOP t
)
(setq URP2 URP
SCALE 1
)
(setq MATRIX (EA:MATRIX_SETTRANSLATION MATRIX URP2))
(redraw EE 3)
(prompt "\n指定第二点: ")
(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
(redraw)
(vla-transformby
(vlax-ename->vla-object (entlast))
(vlax-tmatrix
(EA:MATRIX_SETTRANSLATION
(MREV MATRIX SCALE)
(mapcar '-
URP2
(mapcar '* (list SCALE SCALE SCALE) URP2)
)
)
)
)
;;这里写得不好
;;------------------------------------------------------------
(setq SCALE
(+ 1 (/ (- (distance URP2 PT) (distance URP2 URP)) 10))
)
;;------------------------------------------------------------
(grdraw URP2 PT -1)
(setq URP PT)
)
)
((or (= SOURCE 3) ;拾取点
(and (= SOURCE 2) (or (= PT 13) (= PT 32)))
)
(setq LOOP NIL)
(command "_.ERASE" EE "")
(redraw)
)
((= SOURCE 12) ;ENTER
(setq LOOP NIL)
(command "_.ERASE" E "")
(redraw)
(redraw EE 4)
)
(t)
)
)
(setq *ERROR* OLD_ERROR)
(setvar "cmdecho" HOLDECHO)
(princ)
)
;;----------------------------------------------------------------------
;;矩阵平移一个向量
(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)
)
)
;;----------------------------------------------------------------------
(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)))
)

;;实现动态缩放。 
(defun LAI:FREEMAG (/ HOLDECHO OLD_ERROR E EE URP LOOP URP1 URP2 SOURCE 
                    PT SCALE) 
 
  (defun ERR (MSG) 
    (if        (or (= MSG "Function cancelled") 
            (= MSG "quit / exit abort") 
        ) 
      (princ) 
      (princ (strcat "\nError: " MSG)) 
    ) 
    (command "_.ERASE" E "") 
    (redraw) 
    (redraw EE 4) 
    (if        OLD_ERROR 
      (setq *ERROR* OLD_ERROR) 
    ) 
    (princ) 
  ) 
  (setq HOLDECHO (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (setq OLD_ERROR *ERROR*) 
  (setq *ERROR* ERR) 
  (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 EE (car (entsel))) 
  (command "_.COPY" EE "" "0,0" "@") 
  (setq E (entlast)) 
  (setq        URP  (getpoint "\n指定基准点: ") 
        LOOP t 
  ) 
  (setq        URP2 URP 
        SCALE 1 
  ) 
  (setq MATRIX (EA:MATRIX_SETTRANSLATION MATRIX URP2)) 
  (redraw EE 3) 
  (prompt "\n指定第二点: ") 
  (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 
         (redraw) 
         (vla-transformby 
           (vlax-ename->vla-object (entlast)) 
           (vlax-tmatrix 
             (EA:MATRIX_SETTRANSLATION 
               (MREV MATRIX SCALE) 
               (mapcar '- 
                       URP2 
                       (mapcar '* (list SCALE SCALE SCALE) URP2) 
               ) 
             ) 
           ) 
         ) 
         ;;这里写得不好 
         ;;------------------------------------------------------------ 
         (setq SCALE 
                (+ 1 (/ (- (distance URP2 PT) (distance URP2 URP)) 10)) 
         ) 
         ;;------------------------------------------------------------ 
         (grdraw URP2 PT -1) 
         (setq URP PT) 
       ) 
      ) 
      ((or (= SOURCE 3)                        ;拾取点 
           (and (= SOURCE 2) (or (= PT 13) (= PT 32))) 
       ) 
       (setq LOOP NIL) 
       (command "_.ERASE" EE "") 
       (redraw) 
      ) 
      ((= SOURCE 12)                        ;ENTER 
       (setq LOOP NIL) 
       (command "_.ERASE" E "") 
       (redraw) 
       (redraw EE 4) 
      ) 
      (t) 
    ) 
  ) 
  (setq *ERROR* OLD_ERROR) 
  (setvar "cmdecho" HOLDECHO) 
  (princ) 
) 
 
;;---------------------------------------------------------------------- 
;;矩阵平移一个向量 
(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) 
  ) 
) 
 
;;---------------------------------------------------------------------- 
(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))) 
)

eachy · 发表于 2003-2-24 17:47:51

旋转和缩放矩阵正在写。

梦断江南 · 发表于 2004-10-12 22:54:24

最初由 XDSoft 发布
[B][QUOTE]最初由 eachy 发布
[B][使用GRREAD拖动实体要进行实体变换，重生成，速度要慢。拖动方面的应用还是用实体自身的worldDraw，实体显示自身到屏幕的方法效率更高。还是用 xdrx_pickset_dragGen 更好。 [/B]

xd能否说说怎么利用 worldDraw ?有没有程序实例?vl可以做么?

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

[测试]：XDAPI矩阵应用示例之自由缩放旋转。

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

本帖被以下淘专辑推荐:

相关帖子

Re: [测试]：[测试]：XDAPI矩阵应用示例之自由缩放旋转。

Re: Re: [测试]：[测试]：XDAPI矩阵应用示例之自由缩放旋转。