挑战下吧，有兴趣解决此问题....

尘缘一生 · 发表于 2021-9-5 14:25:53

本帖最后由尘缘一生于 2021-9-5 22:26 编辑

问题总是涉及许多，思路最重要，但苦于没有思路存在,那么。。。。。

一一截图：
这张图，别看不大，它的图元接近10万个
我附件发上

一个课题的解决涉及多类，举一例问题。

比如求得它的包容盒：

包容盒开发多多，能解决这个图吗？
为解决此图运算的快速，我也是尝试，目前均不成功......
代码涉及许多大师的，不一一列举，我没有习惯保留最先出自谁手的介绍，大家应该知道哪部分代码出自谁手。

下面发布几个截图：

;; 外包盒9点坐标---------(一级)--------------------------
;;ss 选择集 n 键位 nil 返回9点(与小键盘数字同)
(defun ss9pt (ss n / num i p0 pti hi ptlis nam ss1 box ptn a p1 p2 p3 p4 p5 p6 p7 p8 p9)
(setq num (sslength ss) i -1)
(if (< num 1000)
(repeat num
(setq nam (ssname ss (setq i (1+ i))))
(setq box (ebox4 nam) ptn (append box ptn))
)
(progn
(command "_zoom" "_object" ss "")
(setq p0 (getvar "viewctr") hi (* (getvar "viewsize") 0.35) i 0)
(while (< i 2pi)
(setq pti (polar p0 (setq i (+ i pi4)) hi))
(setq ptlis (cons pti ptlis))
)
(setq ss1 (ssget "_WP" ptlis))
(command "_zoom" "_p")
(setq ss (ssdiff ss ss1)) ;;选择集差集
(setq num (sslength ss) i -1)
(repeat num
(setq nam (ssname ss (setq i (1+ i))))
(setq box (ebox4 nam) 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)
p2 (list (car p5) (cadr p1))
p3 (list (car p9) (cadr p1))
p4 (list (car p1) (cadr p5))
p6 (list (car p9) (cadr p5))
p7 (list (car p1) (cadr p9))
p8 (list (car p5) (cadr p9))
)
(if (= n nil)
(list p1 p2 p3 p4 p5 p6 p7 p8 p9)
(nth (- n 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))
)
)

；；；-------------

;; 图元--当前坐标系下包围盒,4角点坐标
;; 0 = 左下；1 = 右下；2 = 右上 ; 3 = 左上
;;flag : t时，返回最小包围盒ucs坐标系下坐标4点坐标表；nil时，返回包围盒ucs坐标系下坐标4点坐标表
;;示例 (e-box4 (car (entsel)) t)
(defun e-box4 (ent flag / lst mat mat1 maxpt minpt obJ ucsflag x)
(setq obj (en2obj ent))
(and flag
(setq mat (mat:entitymatrix ent))
(setq mat1 (cadr mat));mat1 4x4
(setq mat (car mat));mat 4x4
)
(if (= (getvar "worlducs") 0)
(setq ucsflag t)
)
(cond
((and flag ucsflag)
(vla-transformby obj (vlax-tmatrix mat))
)
(ucsflag (vla-transformby obj (vlax-tmatrix (mat:u2w))))
(flag (vla-transformby obj (vlax-tmatrix mat)))
)
(vla-getboundingbox obj 'minpt 'maxpt) ;得到包围框
(setq minpt (vlax-safearray->list minpt))
(setq maxpt (vlax-safearray->list maxpt))
(cond
((and flag ucsflag)
(vla-transformby obj (vlax-tmatrix mat1))
)
(ucsflag (vla-transformby obj (vlax-tmatrix (mat:w2u))))
(flag (vla-transformby obj (vlax-tmatrix mat1)))
)
(setq lst (list
minpt
(list (car maxpt) (cadr minpt) (caddr minpt))
maxpt
(list (car minpt) (cadr maxpt) (caddr minpt))
)
)
(cond
(flag nil)
(ucsflag (setq mat1 (mat:w2u)))
)
(cond
((or flag ucsflag)
(setq lst (mapcar '(lambda (x) (mat:mxp mat1 x)) lst)) ;wcs坐标
(setq lst (mapcar '(lambda (x) (trans x ent 1)) lst))
)
)
lst
)
;; 点的矩阵(4x4 matrix) 变换
;; 输入：矩阵m和一个三维点p
;; 输出：点变换后的位置
(defun mat:mxp (m p)
(reverse (cdr (reverse (mat:mxv m (append p '(1.0))))))
)
;;----------------------------------
;; wcs到ucs矩阵，也可称ucs的变换矩阵
(defun mat:w2u () (mat:trans 0 1))
;;---------------------------------------
;; ucs到wcs矩阵，也可称ucs的逆变换矩阵
(defun mat:u2w () (mat:trans 1 0))
;; 从一个坐标系统到另一个坐标系统的变换矩阵
;; 输入：from - 源坐标系；to - 目的坐标系
;; 输出：一个4X4的CAD变换矩阵
(defun MAT:Trans (from to)
(append
(MAT:trp
(list
(trans '(1 0 0) from to t)
(trans '(0 1 0) from to t)
(trans '(0 0 1) from to t)
(trans '(0 0 0) from to nil)
)
)
'((0. 0. 0. 1.))
)
)
;; 向量或点的矩阵变换(向量乘矩阵)
(defun mat:mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
;;---------------------------------------------
;; 平齐实体的变换矩阵
;; 输入：ent - 实体名
;; 输出：平齐这个实体的变换矩阵和它的逆矩阵
;;----------------------------------------------
(defun mat:entitymatrix (ent / z dxf cen obj an m1 mat inv org)
(setq dxf (entget ent))
(if (setq cen (cdr (assoc 10 dxf)))
(if (null (caddr cen))
(setq cen (append cen '(0.0)))
)
(setq cen '(0 0 0))
)
(setq obj (en2obj ent))
(if (and (vlax-property-available-p obj 'elevation)
(wcmatch (vla-get-objectname obj) "*polyline")
)
(setq z (vla-get-elevation obj)
cen (list (car cen) (cadr cen) (+ (caddr cen) z))
)
)
(if (vlax-property-available-p obj 'rotation)
(setq an (vla-get-rotation obj))
(setq an 0)
)
(mat:trans1 0 ent cen an)
)
;; 通用变换矩阵 ------------------------------
;; 输入：from - 原坐标系，
;; to - 目的坐标系，
;; org - 目的坐标系的原点相对原坐标系的位置
;; ang - 相对于原坐标系的旋转角度
;; 输出：两个矩阵，一个是从原坐标系变换到目的坐标系的变换矩阵
;; 一个是从目的坐标系变换到原坐标系的变换矩阵
(defun mat:trans1 (from to org ang / mat rot inv cen)
(setq mat (mapcar (function (lambda (v) (trans v from to t)))
'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
)
)
(if (not (equal ang 0 1e-14))
(setq rot (list (list (cos ang) (- (sin ang)) 0.)
(list (sin ang) (cos ang) 0.)
(list 0. 0. 1.)
)
mat (mat:mxm mat rot)
)
)
(setq cen (trans org to from))
(setq inv (mat:trp mat))
(list
(mat:disptomatrix inv (mat:mxv inv (mapcar '- cen)))
(mat:disptomatrix mat cen)
)
)
;; 把位移矢量添加到矩阵中
;; 输入：mat -- 矩阵(3x3)，disp -- 位移矢量
;; 输出：一个4x4的变换cad的标准变换矩阵
(defun mat:disptomatrix (mat disp)
(append
(mapcar 'append mat (mapcar 'list disp))
'((0. 0. 0. 1.))
)
)
;; 矩阵相乘
(defun mat:mxm (m q)
(mapcar (function (lambda (r) (mat:mxv (mat:trp q) r))) m)
)
;; 矩阵转置
;; 输入：矩阵
;; 输出：转置后的矩阵
(defun mat:trp (m)
(apply 'mapcar (cons 'list m))
)
;;================================================（一级）===================
;;函数 : 找最小面积或包围框
;;Arguments : A CCW HULL
;;返回: 包围框点表(顺时针)及其面积 ((p1 p2 p3 p4) mina)
(defun MinAreaRectangle (ptlist / AA AI BB D1 D2 EDGE I I1X I1Y I2X I2Y IL IX IY J1 J2 MINA MINH MINW NORH NORM PI1 PI2-2 PTI0 PTI1 PTI2 PTJ1 PTK1 PTM1 PTS1 PTS2
PTS3 PTS4 REC1 REC2 REC3 REC4 RECT VECH VECL VJ12 VM12 INF)
(setq INF 1e200)
(setq minA INF)
(setq pti0 (car ptlist))
(setq pts1 (append ptlist (list pti0)))
(setq pts2 (cdr (append ptlist ptlist (list pti0))))
(setq i 0)
(repeat (length ptlist)
(setq pi1 (car pts1)
PI2-2 (cadr pts1)
i1x (car pi1)
i1y (cadr pi1)
i2x (car PI2-2)
i2y (cadr PI2-2)
ix (- i2x i1x)
iy (- i2y i1y)
il (distance (list ix iy) '(0.0 0.0))
)
;;寻找最左点
(while (> (DOTPR ix iy pts2) 0.0)
(setq pts2 (cdr pts2))
)
;;寻找最上点
(if (= i 0)
(setq pts3 pts2)
)
(while (> (CROSSPR ix iy pts3) 0.0)
(setq pts3 (cdr pts3))
)
;;寻找最右点
(if (= i 0)
(setq pts4 pts3)
)
(while (< (DOTPR ix iy pts4) 0.0)
(setq pts4 (cdr pts4))
)
;;得出了每边的矩形
(cond
((equal i1x i2x 1e-4) ;如果边两点的X值相同
(setq d1 (- (caar pts3) i1x) ;那么矩形的高就是最上点与边的X的差值
d2 (- (cadar pts4) (cadar pts2)) ;矩形的宽就是最左和最右的Y的差值
)
)
((equal i1y i2y 1e-4) ;如果边两点的Y值相同
(setq d1 (- (cadar pts3) i1y) ;那么矩形的高就是最上点与边的Y的差值
d2 (- (caar pts4) (caar pts2)) ;矩形的宽就是最左和最右的X的差值
)
)
(T
(setq aa (det pi1 PI2-2 (car pts3))) ;否则计算边和最上点构成的面积的二倍(det)
(setq d1 (/ aa il)) ;高就是det值除以边长
(setq j1 (car pts2)) ;最右边点
(setq j2 (list (- (car j1) iy) (+ (cadr j1) ix))) ;通过最右边点的垂直边的点
(setq bb (det j1 j2 (car pts4))) ;最右边点，上面的点和最左边的点
(setq d2 (/ bb il)) ;这三点的det除以边长就是宽
)
)
;;计算矩形的面积，必要时更新最小面积
(setq Ai (abs (* d1 d2))) ;面积就是高和宽的积
(if (< Ai MinA) ;如果面积小于先前的最小面积，则记录：
(setq MinA Ai ;更新最小面积
MinH d1 ;最小面积的高
MinW d2 ;最小面积的宽
pti1 pi1 ;最小面积的边的第一个端点
pti2 PI2-2 ;最小面积的边的第二个端点
ptj1 (car pts2) ;最右边的点
ptk1 (car pts3) ;最上面的点
ptm1 (car pts4) ;最左边的点
)
)
(setq pts1 (cdr pts1)) ;检测下一条边
(setq i (1+ i)) ;计数器加一
)
(setq edge (mapcar '- pti2 pti1)) ;最小面积的边对应的向量
(setq VecL (distance edge '(0.0 0.0))) ;最小面积的边的长度
(setq NorH (abs (/ MinH VecL))) ;这边的法线
(setq Norm (list (- (cadr edge)) (car edge))) ;这边的垂直向量
(setq vj12 (mapcar '+ ptj1 Norm)) ;通过最右点的垂直向量
(setq vm12 (mapcar '+ ptm1 Norm)) ;通过最左点的垂直向量
(setq vecH (mapcar '* (list NorH NorH) Norm))
(setq rec1 (inters pti1 pti2 ptj1 vj12 nil)) ;矩形的第一点
(setq rec4 (inters pti1 pti2 ptm1 vm12 nil)) ;矩形的第四点
(setq rec2 (mapcar '+ rec1 vecH)) ;矩形的第二点
(setq rec3 (mapcar '+ rec4 vecH)) ;矩形的第三点
(setq rect (list Rec1 rec2 rec3 rec4)) ;矩形的点表
(cons rect MinA) ;返回这个矩形的点表和最小面积
)

;; 选择集中心点--ss 选择集-------(一级)----------------
(defun ssmpt (ss / i s1 box ptn a p1 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
)
;; 图元ent--当前坐标系下包围盒,4角点坐标
;; 0 = 左下；1 = 右下；2 = 右上 ; 3 = 左上 (左下右下右上左上)
(defun ebox4 (ent / lst)
(if (or (/= dxf1 ent "RAY") (/= dxf1 ent "XLINE"))
(if (= (setq lst (e-box4 ent t)) nil)
(setq lst (e-box4 ent nil))
)
)
lst
)

一言总结那就是：对于大量图元，许多，就崩溃了，尝试其他思路，是唯一办法
vla-getboundingbox 它毕竟是对图元处理的，多了，就卡机，会死了。即便我挖去中间区域选择集，仍然死机。
经过这么些尝试均不成，有个想法，那就是，对这个图，第一步先作块--> 求得作块的包容-->再炸开-->

避免大量图元一一计算的问题，但对于这个思路，觉得不好，发帖不是为求谁写代码，有好的办法，思路，请写一句话即可，不用费你精力写。

tigcat · 发表于 2021-9-5 21:39:18

在外面画个框,然后框内bo,然后对bo求box.收工

尘缘一生 · 发表于 2021-9-5 21:47:07

本帖最后由尘缘一生于 2021-9-5 22:04 编辑

tigcat 发表于 2021-9-5 21:39
在外面画个框,然后框内bo,然后对bo求box.收工

那就不能继续开发下去用作他用了，不是自动化了。。。。。。，因为需要传给其他工具的。
一个问题的两方面，不能替代的功能。

;;求屏幕（左下角右上角中点）-------（一级）------------
(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 中心
)

tigcat · 发表于 2021-9-5 21:52:54

尘缘一生发表于 2021-9-5 21:47
那就不能继续开发下去用作他用了，不是自动化了。。。。。。，因为需要传给其他工具的。
一个问题的两方 ...

这堆图形zooma,然后求解出左下右上坐标(屏幕转为图形坐标),做出辅助矩形,在矩形角点极近位置bo,得到一个外围线,删除辅助矩形及bo产生在此处的重合矩形,然后对产生的轮廓线box.OK

panliang9 · 发表于 2021-9-6 09:10:36

用totalboundary求出外轮廓用时1分36秒。不知道其它方法是多少时间。

尘缘一生 · 发表于 2021-9-6 10:16:21

panliang9 发表于 2021-9-6 09:10
用totalboundary求出外轮廓用时1分36秒。不知道其它方法是多少时间。

啊？这么快吗？我看看这个。

xvjiex · 发表于 2021-9-7 09:30:14

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

挑战下吧，有兴趣解决此问题....

本帖子中包含更多资源

点评

本帖子中包含更多资源

点评