选择集中心点的快速求法

尘缘一生 · 发表于 2021-9-4 20:34:51

本帖最后由尘缘一生于 2021-9-4 20:46 编辑

选择集图元很多的时候，会卡机，摸索下怎么快速求得。

;; 选择集中心点--ss 选择集-------(一级)--------------------------
(defun ssmpt1 (ss / i s1 box ptn a p1 p5 num)
;;e 实体名返回 (左下右上)
(defun ebox2p (e / pa pb)
(Vlax-Invoke-Method (en2obj e ) 'GetBoundingBox 'pa 'pb )
(setq pa (trans (vlax-safearray->list pa) 0 1)
pb (trans (vlax-safearray->list pb) 0 1)
)
(list pa pb)
)
;;-----------------------------------------
(setq num (sslength ss) i -1)
(if (< num 100)
(progn
(repeat num
(setq s1 (ssname ss (setq i (1+ i))))
(setq box (ebox2p s1) ptn (append box ptn))
)
(setq a (mapcar '(lambda (x) (apply 'mapcar (cons x ptn))) (list 'min 'max))
p1 (car a)
p9 (cadr a)
p5 (sl:mid p1 p9)
)
)
(progn
(command "_zoom" "_object" ss "")
(setq p5 (getvar "viewctr"))
(command "_zoom" "_p")
)
)
p5
)

想不起是否还有不卡，更快的办法。

cghdy · 发表于 2021-9-6 09:51:24

分享一个别人写的

;;获得选择集的中心
;[用法](GetMidPt  选择集)
;[返回](点)
(defun GetMidPt (ss / i lstX lstY vn pt X1 X2 Y1 Y2)
(setq i 0
lstX '()
lstY '()
)
(repeat (sslength ss)
(setq vn (vlax-ename->vla-object (ssname ss i))
i  (1+ i)
)
(setq pt (vl-catch-all-apply 'vla-getBoundingBox (list vn 'MinPt 'MaxPt)))
(if (not (vl-catch-all-error-p pt))
(progn
(setq
X1 (vlax-safeArray-get-element MinPt 0)
X2 (vlax-safeArray-get-element MaxPt 0)
Y1 (vlax-safeArray-get-element MinPt 1)
Y2 (vlax-safeArray-get-element MaxPt 1)
)
(cond
;; if this is the first time run,then put the value it .
((null lstX)
(setq lstX (list X1 X2)
lstY (list Y1 Y2)
)
)
;; NOTE here,  .
(T
;; X-Min .
(if (< X1 (car lstX))
(setq lstX (list X1 (cadr lstX)))
)
;; X-Max
(if (> X2 (cadr lstX))
(setq lstX (list (car lstX) X2))
)
;; Y-Min .
(if (< Y1 (car lstY))
(setq lstY (list Y1 (cadr lstY)))
)
;; Y-Max
(if (> Y2 (cadr lstY))
(setq lstY (list (car lstY) Y2))
)
)
)
)
)
)
;; return the point  .
(if lstX
(list (* (apply '+ lstX) 0.5) (* (apply '+ lstY) 0.5) 0)
nil
)
)

magicheno · 发表于 2021-9-28 23:05:48

cghdy 发表于 2021-9-6 09:51
分享一个别人写的

;;获得选择集的中心

好用学习了~~~~

qazxswk · 发表于 2022-1-30 12:53:18

我正需要这个，谢谢了

尘缘一生 · 发表于 2022-1-30 19:44:35

本帖最后由尘缘一生于 2022-1-30 20:24 编辑

关于这个问题，还值得研究，我目前这么用的。

;; 选择集中心点--ss 选择集----(一级)----------
(defun ssmpt (ss / i s1 box ptn a p1 p9 p5 num)
(setq num (sslength ss) i -1)
(if (< num 100)
(progn
(repeat num
(setq s1 (ssname ss (setq i (1+ i))))
(setq box (get-box s1) ptn (append box ptn))
)
(setq a (mapcar '(lambda (x) (apply 'mapcar (cons x ptn))) (list 'min 'max))
p1 (car a)
p9 (cadr a)
p5 (sl:mid p1 p9)
)
)
(progn
(command "_zoom" "_object" ss "")
(setq p5 (getvar "viewctr"))
(command "_zoom" "_p")
)
)
p5
)

;返回最大外型两对角点的表 -----（一级)-------------
(defun get-box (ss / len ss1 len1 ptlis pp dis ang pt1 pt2 objlst boxlst minlst maxlst enam obj)
(defun get-ssbox (ss) ;返回集最大外框两对角点的表
(setq len (sslength ss))
(cond
((< len 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))
(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)
(command "_zoom" "_object" ss "")
(setq pp (sl_pm2pt))
(setq pt1 (car pp) pt2 (cadr pp))
(setq dis (distance pt1 pt2) ang (angle pt1 pt2) pt1 (polar pt1 ang (* 0.2 dis)) pt2 (polar pt1 ang (* 0.6 dis)))
(setq ss1 (ssget "W" pt1 pt2))
(setq ss1 (ssdiff ss ss1) len1 (sslength ss1))
(if (< len1 10000)
(get-ssbox ss1)
(progn
(command "_zoom" "_object" ss1 "")
(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
)

894560869 · 发表于 2022-2-11 07:03:38

感谢大佬分享

hubeiwdlue · 发表于 2024-5-17 08:21:17

(command "_zoom" "_object" ss "")
(setq p5 (getvar "viewctr"))，这个太有才了吧，只是不清楚精度怎么样。

Pegasus · 发表于 2024-6-27 03:48:18

谢谢分享。。。

gzcsun · 发表于 2024-6-27 08:15:46

hubeiwdlue 发表于 2024-5-17 08:21
(command "_zoom" "_object" ss "")
(setq p5 (getvar "viewctr"))，这个太有才了吧，只是不清楚精 ...

估计精度差点。
不过速度肯定慢。

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