问龙龙仔

王咣生

上次你回答我如何获得一个块中圆(sub-entity)的圆心坐标,利用nentselp函数得到一个转换矩阵来求得. 如果我不想交互地在屏幕上选取实体，而用程序自动选择，那怎么得到转换矩阵?谢谢版主!

龙龙仔

先设定对象UCS<图块>,再用下列函数护取当前UCS转换矩阵

;;;The ucs matrix function
(defun GETACTIVEUCSMATRIX ()
  ;;(vlax-tmatrix
    (M_REV (append
             (mapcar
               '(lambda        (VECTOR)
                  (append (trans VECTOR 1 0 t) '(0.0))
                )
               '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
             )
             (list (append (getvar "ucsorg") '(1.0)))
           )
    )
  ;;)
)

(defun M_REV (A / N U V)
  (setq N 0)
  (repeat (length A)
    (setq U (cons (mapcar '(lambda (V) (nth N V)) A) U)
          N (1+ N)
    )
  )
  (reverse U)
)

王咣生

有点不明白，“先设定对象UCS<图块>”是什么意思？怎么和GETACTIVEUCSMATRIX 函数连接？

我不知道我的上次问题说的是否明白？就是你给我的程序:
(defun MCS2WCS (TMX P / WX WY WZ)
  (list
    (setq WX
   (+
     (* (car (nth 0 TMX)) (car P))
     (* (cadr (nth 0 TMX)) (cadr P))
     (* (caddr (nth 0 TMX)) (caddr P))
     (cadddr (nth 0 TMX))
   )
    )
    (setq WY
   (+
     (* (car (nth 1 TMX)) (car P))
     (* (cadr (nth 1 TMX)) (cadr P))
     (* (caddr (nth 1 TMX)) (caddr P))
     (cadddr (nth 1 TMX))
   )
    )
    (setq WZ
   (+
     (* (car (nth 2 TMX)) (car P))
     (* (cadr (nth 2 TMX)) (cadr P))
     (* (caddr (nth 2 TMX)) (caddr P))
     (cadddr (nth 2 TMX))
   )
    )
  )
)


;;使用例
(defun C:TT (/ WW TMX P)
  (setq WW (nentselp "\n点选图块中的圆"))
  (setq TMX (caddr WW))
  (setq P (cdr (assoc 10 (entget (car WW)))))
  (MCS2WCS TMX P)
)  


中我不想手工去点选圆实体，怎么办？麻烦你.

龙龙仔

(defun TT (BNAME / BLKDEF ENT P)

;;;先设定对象UCS<图块>,再用下列函数护取当前UCS转换矩阵
;;;The ucs matrix function
  (defun GETACTIVEUCSMATRIX ()
    (M_REV (append
             (mapcar
               '(lambda        (VECTOR)
                  (append (trans VECTOR 1 0 t) '(0.0))
                )
               '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
             )
             (list (append (getvar "ucsorg") '(1.0)))
           )
    )
  )

  (defun M_REV (A / N U V)
    (setq N 0)
    (repeat (length A)
      (setq U (cons (mapcar '(lambda (V) (nth N V)) A) U)
            N (1+ N)
      )
    )
    (reverse U)
  )

;;;This is pretty much straight from AutoLISP Programming... by Rawls & Hagen.
;;;tmx: 4x4 transformation matrix from nentselp - (caddr (nentselp))
;;;p: point to transform
  (defun MCS2WCS (TMX P / WX WY WZ)
    (list
      (setq WX
             (+
               (* (car (nth 0 TMX)) (car P))
               (* (cadr (nth 0 TMX)) (cadr P))
               (* (caddr (nth 0 TMX)) (caddr P))
               (cadddr (nth 0 TMX))
             )
      )
      (setq WY
             (+
               (* (car (nth 1 TMX)) (car P))
               (* (cadr (nth 1 TMX)) (cadr P))
               (* (caddr (nth 1 TMX)) (caddr P))
               (cadddr (nth 1 TMX))
             )
      )
      (setq WZ
             (+
               (* (car (nth 2 TMX)) (car P))
               (* (cadr (nth 2 TMX)) (cadr P))
               (* (caddr (nth 2 TMX)) (caddr P))
               (cadddr (nth 2 TMX))
             )
      )
    )
  )

  (defun DO_IT (/ SS N TMX)
    (setq SS (ssget "x"
                    (list (cons 0 "insert")
                          (cons 2 BNAME)
                          (cons 410 (getvar "CTAB"))
                    )
             )
    )
    (command "_.undo" "m")
    (setq N 0)
    (repeat (sslength SS)
      (command "_.ucs" "_ob" (ssname SS N))
      (setq TMX (GETACTIVEUCSMATRIX))
      ;;打印中心坐标(WCS)
      (print (MCS2WCS TMX P))
      (setq N (1+ N))
    )
    (command "_undo" "b")
  )

  (setq        BLKDEF (vla-item (vla-get-blocks
                           (vla-get-activedocument
                             (vlax-get-acad-object)
                           )
                         )
                         BNAME
               )
  )

;;;取出图块中圆心坐标
;;;假设图块中只有一圆,如附图
  (vlax-for ENT        BLKDEF
    (setq P (cdr (assoc 10 (entget (vlax-vla-object->ename ENT)))))
  )
  (DO_IT)
  (princ)
)

附圖

王咣生

谢谢龙版主,我试成功了;我对没怎么用过VLISP的函数,要明白你的程序看来要花些时间了...谢谢.