选择集对角点（包容盒）--快速求法的思考
本帖最后由 尘缘一生 于 2021-12-30 19:50 编辑[*];;求屏幕（左下角 右上角 中点）-------（一级）------------
[*](defun sl_pm2pt (/ a b c d x)
[*](setq b (getvar "viewsize")
[*] c (car (getvar "screensize"))
[*] d (cadr (getvar "screensize"))
[*] a (* b (/ c d))
[*] x (trans (getvar "viewctr") 1 2)
[*] c (trans (list (- (car x) (* a 0.5)) (- (cadr x) (* b 0.5)) 0.0) 2 1)
[*] d (trans (list (+ (car x) (* a 0.5)) (+ (cadr x) (* b 0.5)) 0.0) 2 1)
[*] e (sl:mid c d)
[*])
[*](list c d e) ;;c 左下d 右上 e 中心
[*])
[*]
[*];返回最大外型两对角点的表 -----（一级)-------------
[*](defun get-box (ss / len ptlis pp objlst boxlst minlst maxlst enam obj)
[*](defun get-ssbox (ss) ;返回集最大外框两对角点的表
[*] (setq len (sslength ss))
[*] (cond
[*] ((< len 500) ;实体小于500，采用高飞鸟求凸包
[*] (setq ptlis (getpt ss 50))
[*] (setq ptlis (graham-scan ptlis))
[*] (if (<= (det (car ptlis) (cadr ptlis) (caddr ptlis)) 0.0)
[*] (setq ptlis (reverse ptlis))
[*] )
[*] (setq pp (car (minarearectangle ptlis)))
[*] (setq ptlis (list (car pp) (caddr pp)))
[*] )
[*] ((and (>= len 500) (< len 10000)) ;实体大于500，小于10000，采用常规
[*] (setq objlst (mapcar 'en2obj (ss-enlst ss)))
[*] (setq boxlst (mapcar 'get-enbox objlst))
[*] (setq minlst (mapcar 'car boxlst))
[*] (setq maxlst (mapcar 'cadr boxlst))
[*] (setq ptlis (list (apply 'mapcar (cons 'min minlst)) (apply 'mapcar (cons 'max maxlst))))
[*] )
[*] ((>= len 10000) ;;实体多于 10000，采用视口近似
[*] (command "_zoom" "_object" ss "")
[*] (setq pp (sl_pm2pt))
[*] (setq ptlis (list (car pp) (cadr pp)))
[*] (command "_zoom" "_p")
[*] )
[*] )
[*])
[*];;返回对象最大外框两对角点的表---------
[*](defun get-enbox (obj)
[*] (if (= (type obj) 'ENAME) (setq obj (en2obj obj)))
[*] (vla-getboundingbox obj 'Minp 'Maxp)
[*] (setq ptlis (mapcar 'vlax-safearray->list (list Minp Maxp)))
[*])
[*];返回点表最大外框两对角点的表
[*](defun get-extents (lst)
[*] (setq ptlis (list (apply 'mapcar (cons 'min lst)) (apply 'mapcar (cons 'max lst))))
[*])
[*](cond
[*] ((= (type ss) 'PICKSET) (get-ssbox ss));集
[*] ((= (type ss) 'ENAME) (get-enbox ss)) ;图元
[*] ((= (type ss) 'LIST) (get-extents ss)) ;点表
[*] (t nil)
[*])
[*]ptlis
[*])
楼主居然还活跃 ;by MP
(defun SSBoundingBox ( ss / _GetBoundingBox _SStoObjects _Main )
(defun _GetBoundingBox ( object / p1 p2 )
(vl-catch-all-apply
'(lambda ( )
(vlax-invoke-method
object
'GetBoundingBox
'p1
'p2
)
)
)
(if p1
( (lambda (data)
(mapcar
'(lambda (funcs)
(mapcar
'(lambda (func)
(apply func data)
)
funcs
)
)
'( (caar cadar)
(caadr cadar)
(caadr cadadr)
(caar cadadr)
)
)
)
(list
(mapcar
'vlax-safearray->list
(list p1 p2)
)
)
)
)
)
(defun _SStoObjects ( ss / i objects )
(if (eq 'pickset (type ss))
(repeat (setq i (sslength ss))
(setq objects
(cons
(vlax-ename->vla-object
(ssname ss
(setq i (1- i))
)
)
objects
)
)
)
)
objects
)
(defun _Main ( ss / boundingboxes )
(cond
( (setq boundingboxes
(vl-remove-if 'null
(mapcar '_GetBoundingBox
(_SStoObjects ss)
)
)
)
(mapcar
'(lambda ( func pair / lst )
(list
(apply (car pair)
(mapcar 'car
(setq lst
(mapcar
func
boundingboxes
)
)
)
)
(apply (cadr pair)
(mapcar 'cadr lst)
)
)
)
'(car cadr caddr cadddr)
'((min min)(max min)(max max)(min max))
)
)
)
)
(_Main ss)
)
感谢大佬分享
页:
[1]