挑战下吧，有兴趣解决此问题....
本帖最后由 尘缘一生 于 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 II1XI1Y I2X I2Y IL IXIY J1 J2 MINA MINH MINW NORH NORMPI1 PI2-2 PTI0 PTI1 PTI2 PTJ1 PTK1 PTM1 PTS1 PTS2
[*] PTS3 PTS4 REC1 REC2REC3 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 它毕竟是对图元处理的，多了，就卡机，会死了。即便我挖去中间区域选择集，仍然死机。
经过这么些尝试均不成，有个想法，那就是，对这个图，第一步先作块--> 求得作块的包容-->再炸开-->
避免大量图元一一计算的问题，但对于这个思路，觉得不好，发帖不是为求谁写代码，有好的办法，思路，请写一句话即可，不用费你精力写。
在外面画个框,然后框内bo,然后对bo求box.收工 本帖最后由 尘缘一生 于 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 中心
[*])
尘缘一生 发表于 2021-9-5 21:47
那就不能继续开发下去用作他用了，不是自动化了。。。。。。，因为需要传给其他工具的。
一个问题的两方 ...
这堆图形zooma,然后求解出左下右上坐标(屏幕转为图形坐标),做出辅助矩形,在矩形角点极近位置bo,得到一个外围线,删除辅助矩形及bo产生在此处的重合矩形,然后对产生的轮廓线box.OK 用totalboundary求出外轮廓用时1分36秒。不知道其它方法是多少时间。 panliang9 发表于 2021-9-6 09:10
用totalboundary求出外轮廓用时1分36秒。不知道其它方法是多少时间。
啊？这么快吗？我看看这个。
页:
[1]