问龙龙仔

王咣生 · 发表于 2003-6-18 10:24:00

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

龙龙仔 · 发表于 2003-6-18 13:05:00

先设定对象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)
)

王咣生 · 发表于 2003-6-18 15:06:00

有点不明白，“先设定对象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)
)
中我不想手工去点选圆实体，怎么办？麻烦你.

龙龙仔 · 发表于 2003-6-19 08:02:00

(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)
)
附圖

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载