VBA中的TransFromBy方法的问题

czx663

   用VBA或者Lisp调用TransFromBy的方法,在下面矩阵时会出现,不能按非统一比例缩放的错误:
    transMat(0, 0) = 1: transMat(0, 1) = 0.70710678118654: transMat(0, 2) = 0#: transMat(0, 3) = 0#
    transMat(1, 0) = 0: transMat(1, 1) = 0.70710678118654: transMat(1, 2) = 0#: transMat(1, 3) = 0#
    transMat(2, 0) = 0#: transMat(2, 1) = 0#: transMat(2, 2) = 1#: transMat(2, 3) = 0#
    transMat(3, 0) = 0#: transMat(3, 1) = 0#: transMat(3, 2) = 0#: transMat(3, 3) = 1#
所以自己写了一个矩阵变换的Lisp:
;|对点进行矩阵变换
返回值: 变换后的点
参数:InPt 输入的点  类型:列表     
     Matrix 用于转换的4*4矩阵 类型:二维表|;
(defun transPtFromBy (InPt Matrix / Str XYZ L M Scale OutPt MyErr OldErr)
  (defun MyErr (msg)
    (setq OutPt nil)
    (alert Str)
  )     ;defun MyErr
  (defun ListMuti (List1 List2 / Num Len n)
    (if (not (= (length List1) (length List2)))
      (progn
(setq str "计算的列表长度不一致")
(exit)
      )
    )     ;if
    (setq Num 0)
    (setq Len (length List1))
    (setq n 0)
    (repeat Len
      (setq Num (+ Num (* (nth n List1) (nth n List2))))
      (setq n (1+ n))
    )
    Num
  )     ;defun ListMuti
(setq OldErr *error*)
(setq *error* MyErr)
  (if (and (listp Matrix) (= 4 (length Matrix)))
    (foreach L Matrix
      (if (and (listp L) (= 4 (length L)))
(foreach M L
   (if (not (numberp m))
     (progn
       (setq str "输入的Matrix类型有误,存在非数值元素")
       (exit)
     )    ;progn
   )
)    ;foreach
(progn
   (setq Str "输入的Matrix元素,有非列表元素或列表不是4*4列表")
   (exit)
)    ;progn
      )     ;if
    )     ;foreach
    (progn
      (setq Str "输入的Matrix不是列表,或不是4*4列表")
      (exit)
    )     ;progn
  )     ;if   ;判断矩阵是否符合要求
  (if (and (listp InPt) (= 3 (length InPt)))
    (foreach XYZ InPt
      (if (not (numberp XYZ))
(progn
   (setq Str "输入点有误,内含非数值元素")
   (exit)
)    ;progn
      )     ;if
    )     ;foreach
    (progn
      (setq Str "输入点有误,请用表输入三维点")
      (exit)
    )     ;progn
  )     ;if 判断输入点是否有否符合要求
  (setq Scale (car (reverse (car (reverse Matrix)))))
  (setq InPt (append Inpt (list 1)))
  (foreach L Matrix
    (setq OutPt (append OutPt (list (* Scale (ListMuti InPt L)))))
  )
  (setq OutPt (reverse (cdr (reverse OutPt))))
(setq *error* OldErr)
  OutPt
)

eachy

高飞版主总结的那个Matrix lisp库基本都涵盖了，可以直接用