选择集中心点的快速求法
本帖最后由 尘缘一生 于 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
[*])
想不起是否还有不卡，更快的办法。
分享一个别人写的
;;获得选择集的中心
;[用法](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
)
)
cghdy 发表于 2021-9-6 09:51
分享一个别人写的
;;获得选择集的中心
好用 学习了~~~~ 我正需要这个，谢谢了 本帖最后由 尘缘一生 于 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
[*])
感谢大佬分享 (command "_zoom" "_object" ss "")
(setq p5 (getvar "viewctr"))，这个太有才了吧，只是不清楚精度怎么样。 谢谢分享。。。 hubeiwdlue 发表于 2024-5-17 08:21
(command "_zoom" "_object" ss "")
(setq p5 (getvar "viewctr"))，这个太有才了吧，只是不清楚精 ...
估计精度差点。
不过速度肯定慢。:lol
页:
[1]