[讨论]如何快速获得当前所有图元的左下角和右上角

雪山飞狐_lzh

与系统变量limmin和limmax无关

龙龙仔

(defun C:BOUND (/ BLK_BOUND PT1 PT2)

(setq BLK_BOUND (ACET-GEOM-SS-EXTENTS (ssget) t))

(setq PT1 (car BLK_BOUND))

(setq PT2 (cadr BLK_BOUND))

(command "_.RECTANG" PT1 PT2)

)

BDYCAD

(defun c:test(/ ss AX:GETBOUNDINGBOX n PT_LIST )
(setq PT_LIST '())
(setq SS (ssget "X"(list '(-4 . "<not")(cons 0 "xline,rays")'(-4 . "not>"))))
(defun AX:GETBOUNDINGBOX (ENT / LL UR pt1 pt2)
(vla-getboundingbox (vlax-ename->vla-object ENT) 'LL 'UR)
(mapcar 'vlax-safearray->list (list LL UR)))
(setq N 0)
(repeat (sslength SS)
(setq PT_LIST (append PT_LIST (list (AX:GETBOUNDINGBOX (ssname SS N)))))
(setq N (1+ N)))
PT_LIST)

BDYCAD

二樓龍龍仔您好 ACET-GEOM-SS-EXTENTS 這個是什麼涵數? 我這里用 Command: BOUND
Select objects: 1 found Select objects: ; error: no function definition: ACET-GEOM-SS-EXTENTS

无痕

ACET-GEOM-SS-EXTENTS 是expresstools 的函数，功能相对于下面的(test),不过龙龙仔 那个t参数是怎么解释的？

2.   
3. (defun test ( / n e ll ur xlst ylst)
4.    (setq ss (ssget "x" '((0 . "~xline,~ray"))))
5.    (repeat (setq n (sslength ss))
6.        (setq e (ssname ss (setq n (1- n))))
7.        (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
8.        (mapcar '(lambda (x) (setq lst (cons (vlax-safearray->list x) lst))) (list ll ur))
9.    )
10.    (setq xlst (vl-sort (mapcar 'car lst) '< )
11.   ylst (vl-sort (mapcar 'cadr lst) '< ))
12.    (list (list (car xlst) (car ylst))(list (last xlst) (last ylst)))
13. );;测试:
14. (setq lst (test))
15. (vl-cmdf ".rectangle" (car lst)(cadr lst))
16.   

   (defun test ( / n e ll ur xlst ylst)    (setq ss (ssget "x" '((0 . "~xline,~ray"))))    (repeat (setq n (sslength ss))        (setq e (ssname ss (setq n (1- n))))        (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)        (mapcar '(lambda (x) (setq lst (cons (vlax-safearray->list x) lst))) (list ll ur))    )    (setq xlst (vl-sort (mapcar 'car lst) '< )   ylst (vl-sort (mapcar 'cadr lst) '< ))    (list (list (car xlst) (car ylst))(list (last xlst) (last ylst))) );;测试: (setq lst (test)) (vl-cmdf ".rectangle" (car lst)(cadr lst))   

雪山飞狐_lzh

把两位斑竹的程序合在一起可以解决我的问题 (defun C:BOUND (/ BLK_BOUND PT1 PT2)
(setq BLK_BOUND (ACET-GEOM-SS-EXTENTS (ssget "X"(list '(-4 . "<not")(cons 0 "xline,rays")'(-4 . "not>"))) t))
(setq PT1 (car BLK_BOUND))
(setq PT2 (cadr BLK_BOUND))
(command "_.RECTANG" PT1 PT2)
) 怎样把PT1和PT2放在Userr系统变量里? Lisp我实在不懂

雪山飞狐_lzh

谢了

BDYCAD

怎样把PT1和PT2放在Userr系统变量里?


       


樓上的 這個用來做什麼來的?

雪山飞狐_lzh

我在VBa里做好了 Public Sub test()
Dim ss As AcadSelectionSet
Dim i As AcadEntity
Set ss = ThisDrawing.ActiveSelectionSet
ss.Select acSelectionSetAll
ss(0).GetBoundingBox pmin, pmax
For Each i In ss
i.GetBoundingBox p1, p2
If p1(0) < pmin(0) Then pmin(0) = p1(0)
If p1(1) < pmin(1) Then pmin(1) = p1(1)
If p2(0) > pmax(0) Then pmax(0) = p2(0)
If p2(1) > pmax(1) Then pmax(1) = p2(1)
Next i
ThisDrawing.SendCommand "_.RECTANG " & pmin(0) & "," & pmin(1) & vbCr & pmax(0) & "," & pmax(1) & vbCr
End Sub
用龙斑竹的办法16240个实体大概用了8秒 我的程序用了2秒 我要的是快速

BDYCAD

嘩. 真讓我大開眼界哦. 這麼快的速度.