所有对象的边界框？
我似乎记得能够返回当前图形中所有对象的边界框。类似于最大化显示。这是我编的吗？布瑞恩 多亏了Vovka
bbox。拉链 ;;;***********************************************************************************
;;;PROGRAM CREATED FOR SELECTION SET BOUNDARY
;;;DATE: MAY 2008
;;;BY: wizman
;;;
;;;
;;;
;;;TYPE "BBS" TO START COMMAND
;;;
;;;
;;;
;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
(defun c:BBS (/ all_max all_min ll_pt maxpt minpt myset ur_pt)
(vl-load-com)
(setq all_min '()
all_max '()
) ;_ end_setq
(if (setq mySet (ssget))
;;"_X" '((410 . "Model"))))
(progn
(foreach x
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr
(ssnamex myset)
) ;_ end_mapcar
) ;_ end_vl-remove-if
) ;_ end_mapcar
(vla-GetBoundingBox x 'minpt 'maxpt)
(Setq all_min (cons (trans (vlax-safearray->list minpt) 1 0) all_min))
(Setq all_max (cons (trans (vlax-safearray->list maxpt) 1 0) all_max))
) ;_ end_foreach
(setq LL_pt (list (car (vl-sort (mapcar 'car all_min) '<))
(car (vl-sort (mapcar 'cadr all_min) '<))
) ;_ end_list
) ;_ end_setq
(setq UR_pt (list (last (vl-sort (mapcar 'car all_max) '<))
(last (vl-sort (mapcar 'cadr all_max) '<))
) ;_ end_list
) ;_ end_setq
(mapcar 'princ (list "\nlower left:>> " ll_pt "\nupper right:>> " ur_pt))
(grvecs (append '(1)
(list ll_pt
(list (car ur_pt) (cadr ll_pt))
(list (car ur_pt) (cadr ll_pt))
ur_pt
ur_pt
(list (car ll_pt) (cadr ur_pt))
(list (car ll_pt) (cadr ur_pt))
ll_pt
) ;_ end_list
) ;_ end_append
) ;_ end_grvecs
;;(textpage)
) ;_ end_progn
) ;_ end_if
(princ)
) ;_ end_defun
(princ) 做得很好，弗拉基米尔！ 太好了，弗拉德！你展示动画的方式很酷，这很有帮助
我刚刚复制了你的代码，我要试试。
如果是这样的话，那么从视觉上看到边界框会很酷。
我现在就去看看。
这是我的代码。。。。
这将提示您输入块引用，在您选择blkref后，它将获取该blkref边界框的中点，并提示您输入目标点。
如有必要，对定位块非常有用
如果我要创建一组幻灯片，我将在ACAD中设置一个网格（数组），然后将我的所有块插入到该图形中，然后使用此代码，我可以很容易地将所有块都放在中间。
然后我有代码，可以在一次弹出中为该图形中的所有块创建幻灯片。
M
;| ! *******************************************************************
;; ! lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'- Точка для анализа в МСК!!!
;; ! Return : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
SSZ (getvar "SCREENSIZE")
X_Pix (car SSZ) Y_Pix (cadr SSZ)
X_Len (* (/ X_Pix Y_Pix) Y_Len)
Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
Uc (polar Lc 0.0 X_Len)
Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
(> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)))
T nil))
(defun DTR (a)(* pi (/ a 180.0)))
;| ! ***************************************************************************
;; ! lib:pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' - Список точек
;; ! Returns: Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defunlib:pt_extents (vlist / tmp)
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
(mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
'(0 1 2))));_setq
(list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
;http://www.theswamp.org/index.php?topic=15123.0
;;;(defun GetBoundingBox-3d (pt_lst)
;;;(list (apply 'mapcar (cons 'min pt_lst))
;;; (apply 'mapcar (cons 'max pt_lst))
;;;)
;;
; ! ***********************************************************
;; ! lib:Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' - Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns: t - было зуммирование nil - нет
;; ! **********************************************************
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
(setq Lst (lib:pt_extents vlist)
bl (car Lst) tr (cadr Lst))
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn(setq OS (getvar "OSMODE"))(setvar "OSMODE" 0)
(command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1)
"_.Zoom" "0.95x")
(setvar "OSMODE" OS)
T) NIL))
;External contour of objects
(defun C:ECO ( / *error* blk obj MinPt MaxPt hiden pt pl unnamed_block isRus
tmp_blk adoc blks lays lay oname sel csp loc sc ec ret DS osm iNSpT)
(defun *error* (msg)(princ msg)(mapcar '(lambda (x) (vla-put-Visible x :vlax-true)) hiden)
(vla-endundomark adoc)(if (and tmp_blk (not (vlax-erased-p tmp_blk))(vlax-write-enabled-p tmp_blk) )
(vla-Erase tmp_blk))(if osm (setvar "OSMODE" osm))(foreach x loc (vla-put-lock x :vlax-true)))
(vl-load-com)(setvar "CMDECHO" 0)(setq osm (getvar "OSMODE"))
(if (zerop (getvar "WORLDUCS"))(progn(vl-cmdf "_.UCS" "")(vl-cmdf "_.Plan" "")))
(setq isRus (= (getvar "SysCodePage") "ANSI_1251"))
(setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
blks (vla-get-blocks adoc) lays (vla-get-layers adoc))
(vla-startundomark adoc)(if isRus (princ "\nВыберите объекты для построения контура")(princ "\nSelect objects for making a contour"))
(vlax-for lay lays
(if (= (vla-get-lock lay) :vlax-true)
(progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc))))
)
(if (setq sel (ssget))(progn
(setq sel (ssnamex sel))
;;; (setq iNSpT(apply 'mapcar (cons 'min
;;; (mapcar 'cadr (apply 'append (mapcar '(lambda(x)(vl-remove-if-not 'listp x)) sel))))))
(setq iNSpT '(0 0 0))
(setq sel (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr sel))))
(setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))
; (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point '(0. 0. 0.)) "*U"))
(setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point inspt) "*U"))
(foreach x sel
(setq oname (strcase (vla-get-objectname x)))
(cond ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" "ACDBTEXT")) nil)
((= oname "ACDBBLOCKREFERENCE")
(vla-InsertBlock unnamed_block
(vla-get-insertionpoint x)(vla-get-name x)
(vla-get-xscalefactor x)(vla-get-yscalefactor x)
(vla-get-zscalefactor x)(vla-get-rotation x))
(setq blk (cons x blk)))
(t (setq obj (cons x obj)))));_foreach
(setq lay(vla-item lays (getvar "CLAYER")))
(if (= (vla-get-lock lay) :vlax-true)(progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc))))
(if obj (progn (vla-copyobjects (vla-get-activedocument (vlax-get-acad-object))
(vlax-make-variant (vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj))))
obj)) unnamed_block)))
(setq obj (append obj blk))
(if obj (progn
;(setq tmp_blk (vla-insertblock csp (vlax-3d-point '(0. 0. 0.))(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0))
(setq tmp_blk (vla-insertblock csp (vlax-3d-point inspt)(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0))
(vla-GetBoundingBox tmp_blk 'MinPt 'MaxPt);_Границы блока
(setq MinPt (vlax-safearray->list MinPt) MaxPt (vlax-safearray->list MaxPt)
DS (max (distance MinPt (list (car MinPt)(cadr MaxPt)))
(distance MinPt (list (car MaxPt)(cadr MinPt))))
DS (* 0.2 DS) ;1/5
DS (max DS 10) MinPt (mapcar '- MinPt (list DS DS))
MaxPt (mapcar '+ MaxPt (list DS DS)))
(lib:Zoom2Lst (list MinPt MaxPt))(setq sset (ssget "_C" MinPt MaxPt))
(if sset (progn (setvar "OSMODE" 0)
(setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
hiden (vl-remove tmp_blk hiden))
(mapcar '(lambda(x)(vla-put-Visible x :vlax-false)) hiden)
(setq pt (mapcar '+ MinPt (list (* 0.5 DS)(* 0.5 DS))))
(vl-cmdf "_.RECTANG" (trans MinPt 0 1)(trans MaxPt 0 1))
(setq pl (vlax-ename->vla-object(entlast)))
(setq sc (1-(vla-get-count csp)))
(if (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY '(lambda ()
(vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
(while (> (getvar "CMDACTIVE") 0)(command "")))))
(if isRus (princ "\nНе удалось построить контур")(princ "\nIt was not possible to construct a contour")))
(setq ec (vla-get-count csp))
(while (< sc ec)(setq ret (append ret (list (vla-item csp sc))) sc(1+ sc)))
(setq ret (vl-remove pl ret))
(mapcar '(lambda (x)(vla-Erase x)(vlax-release-object x))(list pl tmp_blk))(setq pl nil tmp_blk nil)
(setq ret (mapcar '(lambda ( x / mipt)(vla-GetBoundingBox x 'MiPt nil);_Границы блока
(setq MiPt (vlax-safearray->list MiPt))(list MiPt x)) ret))
(setq ret (vl-sort ret '(lambda (e1 e2)(< (distance MinPt (car e1))(distance MinPt (car e2))))))
(setq pl (nth 1 ret) ret (vl-remove pl ret)) (mapcar 'vla-erase (mapcar 'cadr ret))
(mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden)
(foreach x loc (vla-put-lock x :vlax-true))
(if pl (progn (initget"Yes No")
(if (= (getkword (if isRus "\nУдалять объекты? <No> : " "\nDelete objects? <No> : ")) "Yes")
(mapcar '(lambda (x) (if (vlax-write-enabled-p x)(vla-Erase x))) obj)))
(if isRus (princ "\nНе удалось построить контур")(princ "\nIt was not possible to construct a contour")))))))
(VL-CATCH-ALL-APPLY '(lambda ()(mapcar 'vlax-release-object
(list unnamed_block tmp_blk csp blks lays))))));_if not
(foreach x loc (vla-put-lock x :vlax-true))(setvar "OSMODE" osm)
(vla-endundomark adoc)(vlax-release-object adoc)(princ))
Wiz公司
Lisp程序的程序很酷
到目前为止，我只在一个块上尝试了它，但它对所有具有边界框的实体都有效吗？
此外，如果您这样做，用户可以选择他们想要查看其边界框的实体，那将非常酷。
这就是我想使用它的方式
做记号 您好，ML，用户现在可以进行选择。此外，您编写的vva代码很好。
我比赛迟到了，但有没有办法增加这个Lisp程序的缓冲区？如忽略某些大小的差距？ 要创建忽略间隙的轮廓，可以尝试TotalBoundary实用程序。
查看此视频： 谢谢，我以前用过TotalBoundary，它真是棒极了！但是它并没有像我想的那样工作，我希望能够将代码合并到带有附加组件的LISP中。
但是谢谢！
页:
[1]
2