函数 UcsBoundingBox

lucas3 · 发表于 2014-12-12 18:20:54

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

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

×

by gile

;; gc:TMatrixFromTo
;; Returns the 4X4 transformation matrix from a coordinate system to an other one
;;
;; Arguments
;; from to: same arguments as for the 'trans' function
(defun gc:TMatrixFromTo (from to)
(append
(mapcar
(function
(lambda (v o)
(append (trans v from to T) (list o))
)
)
(list '(1. 0. 0.) '(0. 1. 0.) '(0. 0. 1.))
(trans '(0. 0. 0.) to from)
)
(list '(0. 0. 0. 1.))
)
)
;; gc:UcsBoundingBox
;; Returns the UCS coordinates of the object bounding box about current UCS
;;
;; Arguments
;; obj: an entity (ENAME or VLA-OBJCET)
;; _OutputMinPtSym: a quoted symbol (output)
;; _OutputMaxPtSym: a quoted symbol (output)
(defun gc:UcsBoundingBox (obj _OutputMinPtSym _OutputMaxPtSym)
(vl-load-com)
(and (= (type obj) 'ENAME)
(setq obj (vlax-ename->vla-object obj))
)
(vla-TransformBy obj (vlax-tmatrix (gc:TMatrixFromTo 1 0)))
(vla-GetBoundingBox obj _OutputMinPtSym _OutputMaxPtSym)
(vla-TransformBy obj (vlax-tmatrix (gc:TMatrixFromTo 0 1)))
(set _OutputMinPtSym (vlax-safearray->list (eval _OutputMinPtSym)))
(set _OutputMaxPtSym (vlax-safearray->list (eval _OutputMaxPtSym)))
)
;; gc:SelSetUcsBBox
;; Returns the UCS coordinates of the object bounding box about current UCS
;;
;; Arguments
;; ss: a selection set
;; _OutputMinPtSym: a quoted symbol (output)
;; _OutputMaxPtSym: a quoted symbol (output)
(defun gc:SelSetUcsBBox (ss _OutputMinPtSym _OutputMaxPtSym / n l1 l2)
(repeat (setq n (sslength ss))
(gc:UcsBoundingBox (ssname ss (setq n (1- n))) _OutputMinPtSym _OutputMaxPtSym)
(setq l1 (cons (eval _OutputMinPtSym) l1)
l2 (cons (eval _OutputMaxPtSym) l2)
)
)
(set _OutputMinPtSym (apply 'mapcar (cons 'min l1)))
(set _OutputMaxPtSym (apply 'mapcar (cons 'max l2)))
)

;; gc:TMatrixFromTo 
;; Returns the 4X4 transformation matrix from a coordinate system to an other one 
;; 
;; Arguments 
;; from to: same arguments as for the 'trans' function 
 
(defun gc:TMatrixFromTo (from to) 
  (append 
    (mapcar 
      (function 
  (lambda  (v o) 
    (append (trans v from to T) (list o)) 
  ) 
      ) 
      (list '(1. 0. 0.) '(0. 1. 0.) '(0. 0. 1.)) 
      (trans '(0. 0. 0.) to from) 
    ) 
    (list '(0. 0. 0. 1.)) 
  ) 
) 
 
;; gc:UcsBoundingBox 
;; Returns the UCS coordinates of the object bounding box about current UCS 
;; 
;; Arguments 
;; obj: an entity (ENAME or VLA-OBJCET) 
;; _OutputMinPtSym: a quoted symbol (output) 
;; _OutputMaxPtSym: a quoted symbol (output) 
 
(defun gc:UcsBoundingBox (obj _OutputMinPtSym _OutputMaxPtSym) 
  (vl-load-com) 
  (and (= (type obj) 'ENAME) 
       (setq obj (vlax-ename->vla-object obj)) 
  ) 
  (vla-TransformBy obj (vlax-tmatrix (gc:TMatrixFromTo 1 0))) 
  (vla-GetBoundingBox obj _OutputMinPtSym _OutputMaxPtSym) 
  (vla-TransformBy obj (vlax-tmatrix (gc:TMatrixFromTo 0 1))) 
  (set _OutputMinPtSym (vlax-safearray->list (eval _OutputMinPtSym))) 
  (set _OutputMaxPtSym (vlax-safearray->list (eval _OutputMaxPtSym))) 
) 
 
;; gc:SelSetUcsBBox 
;; Returns the UCS coordinates of the object bounding box about current UCS 
;; 
;; Arguments 
;; ss: a selection set 
;; _OutputMinPtSym: a quoted symbol (output) 
;; _OutputMaxPtSym: a quoted symbol (output) 
 
(defun gc:SelSetUcsBBox  (ss _OutputMinPtSym _OutputMaxPtSym / n l1 l2) 
  (repeat (setq n (sslength ss)) 
    (gc:UcsBoundingBox (ssname ss (setq n (1- n))) _OutputMinPtSym _OutputMaxPtSym) 
    (setq l1 (cons (eval _OutputMinPtSym) l1) 
    l2 (cons (eval _OutputMaxPtSym) l2) 
    ) 
  ) 
  (set _OutputMinPtSym (apply 'mapcar (cons 'min l1))) 
  (set _OutputMaxPtSym (apply 'mapcar (cons 'max l2))) 
)

for test

(defun c:test (/ ss minpt maxpt)
(if (setq ss (ssget))
(progn
(gc:SelSetUcsBBox ss 'minpt 'maxpt)
(vl-cmdf
(if (equal (caddr minpt) (caddr maxpt) 1e-6)
"_.rectangle"
"_.box"
)
"_non"
minpt
"_non"
maxpt
)
)
)
(princ)
)

Another one.

;;;Function: Get BuondingBox
;;;arg :
;;; ss -- Select set or a Ename
;;; onseg -- T or NIL , if T then returns the box in UCS , if NIL in WCS
;;;Support in UCS
;;;Written by Highflybird
;;;Edited by GSLS(SS), 2011-02-16
(defun ss-get-boundingbox (ss onseg / Wmat Umat i
ent obj minPt maxPt minLs maxLs
maxX maxY minX minY pts
)
(if ss
(progn
(if (eq (type ss) 'ENAME)
(setq ss (ssadd ss (ssadd)))
)
(if (and onseg (= (getvar "WORLDUCS") 0))
(setq Wmat (gc:TMatrixFromTo 1 0)
Umat (gc:TMatrixFromTo 0 1)
);_Use gile's nice function
)
(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)
)
(if Wmat
(vla-TransformBy obj (vlax-tmatrix Wmat))
)
(vla-GetBoundingBox obj 'minpt 'maxpt)
(setq minPt (vlax-safearray->list minPt)
maxPt (vlax-safearray->list maxPt)
minLs (cons minPt minLs)
maxLs (cons maxPt maxLs)
)
(if Umat
(vla-TransformBy obj (vlax-tmatrix Umat))
)
(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)))
(setq pts (list (list minX minY 0)
(list maxX minY 0)
(list maxX maxY 0)
(list minX maxY 0)
)
)
(if Wmat
(mapcar (function (lambda (x)
(trans x 1 0)
)
)
pts
)
pts
)
)
)
)
(defun c:test (/
ss
)
;(svos)
(if (setq ss (ssget))
(draw-pl (list (ss-get-boundingbox ss NIL)));_test in UCS return the wcs box
)
;(clos)
(princ)
)
(defun draw-pl (lst)
(entmake
(append
'((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
)
(list (cons 90 (length (car lst))))
(mapcar (function (lambda (x) (cons 10 x))) (car lst))
(list (cons 70 1))
(cdr lst)
)
)
)

;;;Function: Get BuondingBox 
;;;arg : 
;;;      ss -- Select set or a Ename 
;;;   onseg -- T or NIL , if T then returns the box in UCS , if NIL in WCS 
;;;Support in UCS 
;;;Written by Highflybird 
;;;Edited by GSLS(SS), 2011-02-16 
(defun ss-get-boundingbox (ss    onseg   /  Wmat   Umat   i 
         ent    obj   minPt  maxPt  minLs  maxLs 
         maxX    maxY   minX  minY pts 
        ) 
  (if ss 
    (progn 
      (if (eq (type ss) 'ENAME) 
  (setq ss (ssadd ss (ssadd))) 
      ) 
      (if (and onseg (= (getvar "WORLDUCS") 0)) 
  (setq Wmat (gc:TMatrixFromTo 1 0) 
        Umat (gc:TMatrixFromTo 0 1) 
  );_Use gile's nice function 
      ) 
      (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) 
  ) 
  (if Wmat 
    (vla-TransformBy obj (vlax-tmatrix Wmat)) 
  ) 
  (vla-GetBoundingBox obj 'minpt 'maxpt) 
  (setq minPt (vlax-safearray->list minPt) 
        maxPt (vlax-safearray->list maxPt) 
        minLs (cons minPt minLs) 
        maxLs (cons maxPt maxLs) 
  ) 
  (if Umat 
    (vla-TransformBy obj (vlax-tmatrix Umat)) 
  ) 
  (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))) 
      (setq pts  (list (list minX minY 0) 
          (list maxX minY 0) 
          (list maxX maxY 0) 
          (list minX maxY 0) 
    ) 
      ) 
      (if Wmat 
  (mapcar  (function (lambda (x) 
          (trans x 1 0) 
        ) 
    ) 
    pts 
  ) 
  pts 
      ) 
    ) 
  ) 
) 
(defun c:test (/ 
       ss 
      ) 
  ;(svos) 
  (if (setq ss (ssget)) 
    (draw-pl (list (ss-get-boundingbox ss NIL)));_test in UCS return the wcs box 
  ) 
  ;(clos)   
  (princ) 
) 
(defun draw-pl (lst) 
  (entmake 
    (append 
      '((0 . "LWPOLYLINE") 
  (100 . "AcDbEntity") 
  (100 . "AcDbPolyline") 
       ) 
      (list (cons 90 (length (car lst)))) 
      (mapcar (function (lambda (x) (cons 10 x))) (car lst)) 
      (list (cons 70 1)) 
      (cdr lst) 
    ) 
  ) 
)

newer · 发表于 2014-12-12 18:35:03

做什么用的，能给介绍介绍吗？

GILE是谁？

lucas3 · 发表于 2014-12-12 18:42:11

newer 发表于 2014-12-12 18:35
做什么用的，能给介绍介绍吗？

GILE是谁？

回版主大人，这个不用介绍了吧，你应该一看就懂的，哈哈，
Gile 是theswamp 上的一位牛人，分享过很多函数，赞！

newer · 发表于 2014-12-12 18:44:11

lucas3 发表于 2014-12-12 18:42
回版主大人，这个不用介绍了吧，你应该一看就懂的，哈哈，
Gile 是theswamp 上的一位牛人，分享过很多函 ...

我知道不代表别人也知道啊，所以分享函数最好是说下做什么的，如果有图就更好了。

lucas3 · 发表于 2014-12-12 18:50:36

newer 发表于 2014-12-12 18:44
我知道不代表别人也知道啊，所以分享函数最好是说下做什么的，如果有图就更好了。

上面有英文注释的，懂lisp的应该都明白的，你都知道我是一个门外汉，你要我解释，我只能抓狂了{:soso_e118:}

dnbcgrass · 发表于 2014-12-12 19:39:51

当ss中有样条曲线时，结果似乎不正确。

xvjiex · 发表于 2021-7-30 00:26:03

感谢楼主分享函数 UcsBoundingBox

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

[每日一码] 函数 UcsBoundingBox

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

评分

点评

点评

点评