Here's my poor way .
;;;Function: Get BuondingBox
;;;arg : Select set or a Ename
;;;Support in UCS
;;;Written by Highflybird
;;;Edited by GSLS(SS), 2011-02-15
(defun ss-get-boundingbox (ss / getrcsmatrix lst
UcsFlag matrix i ent obj
minPt maxPt minLs maxLs maxX
maxY minX minY
)
(defun getrcsmatrix (lst org / m i j)
(setq m ([0] 4 4)
m (ch-lst 1.0 (list 3 3) m)
i -1
)
(repeat 3
(setq i (1+ i)
m (ch-lst (nth i org) (list i 3) m)
j -1
)
(repeat 3
(setq j (1+ j))
(setq m (ch-lst (nth i (nth j lst)) (list i j) m))
)
)
)
(setq UcsFlag (getvar "WORLDUCS"))
(if (= UcsFlag 0)
(setq UcsFlag T
xdir (getvar "UCSXDIR")
ydir (getvar "UCSYDIR")
zdir (CrossProduct xdir ydir)
origin (getvar "UCSORG")
WcsOrg (trans '(0 0 0) 0 1)
matLst (list xdir ydir zdir)
matrix (getrcsmatrix matLst origin) ;_change in lisp
)
(setq UcsFlag nil)
)
(if ss
(progn
(if (eq (type ss) 'ENAME)
(setq ss (ssadd ss (ssadd)))
)
(setq i 0)
(setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
(setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
(repeat (sslength ss)
(setq ent (ssname ss i)
obj (vlax-ename->vla-object ent)
)
(and UcsFlag
(vla-TransformBy obj (vlax-tmatrix ([uinv] matrix)))
)
(vla-GetBoundingBox obj 'minpt 'maxpt)
(setq minPt (vlax-safearray->list minPt)
maxPt (vlax-safearray->list maxPt)
minLs (cons minPt minLs)
maxLs (cons maxPt maxLs)
)
(and UcsFlag (vla-TransformBy obj (vlax-tmatrix matrix)))
(setq i (1+ i))
)
;_Is there better way to get the other coner points , if it's in 3D UCS ?
;_Perhaps it'n use 'trans' function ...
(setq minX (apply 'min (mapcar 'car minLs)))
(setq minY (apply 'min (mapcar 'cadr minLs)))
(setq maxX (apply 'max (mapcar 'car maxLs)))
(setq maxY (apply 'max (mapcar 'cadr maxLs)))
(mapcar (function (lambda (x)
(trans x 1 0)
)
)
(list (list minX minY 0);_if the Z-Axis coor is not 0 , and mixpt's value is not eq maxpt's ?
(list maxX minY 0)
(list maxX maxY 0)
(list minX maxY 0)
)
)
)
)
)
;;; Crossproduct
(defun CrossProduct (v1 v2)
(list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
)
)
;;;written by qj-chen
;;;Edited by GSLS(SS)
(defun ch-lst (new i lst / j len fst mid)
(if (/= (type i) 'list)
(cond
((minusp i)
lst
)
((> i (setq len (length lst)))
lst
)
((> i (/ len 2))
(reverse (ch-lst new (1- (- len i)) (reverse lst)))
)
(t
(append
(progn
(setq fst nil)
(repeat (rem i 4)
(setq fst (cons (car lst) fst)
lst (cdr lst)
)
)
(repeat (/ i 4)
(setq fst (cons (cadddr lst)
(cons (caddr lst)
(cons
(cadr lst)
(cons
(car lst)
fst
)
)
)
)
lst (cddddr lst)
)
)
(reverse fst)
)
(list new)
(cdr lst)
)
)
)
(progn
(setq j (cadr i)
i (car i)
)
(if j
(progn
(setq mid (nth i lst))
(setq mid (ch-lst new j mid))
(ch-lst mid i lst)
)
(ch-lst new i lst)
)
)
)
)
Use Gile's invers maxrix func
;;;transpose
(defun [trp] (a)
(apply 'mapcar (cons 'list a))
)
;;; gile-cofact (gile)
;;; returns the gile-cofactor associated to ij item of a matrix
;;;
;;; arguments
;;; i = row index (first row = 1)
;;; j = column index (first column = 1)
;;; m = a matrix
;;;(gile-cofact 1 2 a)
(defun gile-cofact (i j m)
(* ([mo]
(remove-nth (list (1- i) (1- j)) m)
)
(expt -1 (+ i j))
)
)
;;; gile-determ (gile)
;;; returns the determinant of a matrix
;;; argument : a matrix
(defun [mo] (m)
(if (null (caddr m));_原语句(= (length m) 2);_(null (caddr m))
(- (* (caar m) (cadadr m)) (* (caadr m) (cadar m)))
((lambda (r n)
(apply
'+
(mapcar
(function (lambda (x)
(* x
(gile-cofact
1
(setq n (1+ n))
m
)
)
)
)
r
)
)
)
(car m)
0
)
)
)
;;; gile-adj-mat (gile)
;;; returns the adjugate matrix
;;;
;;; argument : a matrix
;;;(gile-adj-mat a)
(defun gile-adj-mat (m / i)
(setq i 0)
([trp] (mapcar
(function (lambda (v / j)
(setq i (1+ i)
j 0
)
(mapcar
(function (lambda (x)
(gile-cofact
i
(setq j (1+ j))
m
)
)
)
v
)
)
)
m
)
)
)
;;; gile-inv-mat (gile)
;;; inverse a matrix
;;;
;;; argument : a matrix
;;;(gile-inv-mat m)
(defun [uinv] (m / d)
(if (/= 0 (setq d ([mo] m)))
(mapcar
(function (lambda (v)
(mapcar
(function (lambda (x)
(* (/ 1 d) x)
)
)
v
)
)
)
(gile-adj-mat m)
)
)
)
