明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 234|回复: 8

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

[复制链接]
发表于 2021-9-5 14:25 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 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 它毕竟是对图元处理的,多了,就卡机,会死了。即便我挖去中间区域选择集,仍然死机。
   经过这么些尝试均不成,有个想法,那就是,对这个图,第一步先作块--> 求得作块的包容-->再炸开-->

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




本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
发表于 2021-9-5 21:39 | 显示全部楼层
在外面画个框,然后框内bo,然后对bo求box.收工
 楼主| 发表于 2021-9-5 21:47 | 显示全部楼层
本帖最后由 尘缘一生 于 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:52 | 显示全部楼层
尘缘一生 发表于 2021-9-5 21:47
那就不能继续开发下去用作他用了,不是自动化了。。。。。。,因为需要传给其他工具的。
一个问题的两方 ...

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

点评

对,求中点,这么解决可以,还有另外问题,就是,求包容盒9点坐标就不行了。  发表于 2021-9-5 21:56
发表于 2021-9-6 09:10 | 显示全部楼层
用totalboundary求出外轮廓用时1分36秒。不知道其它方法是多少时间。
 楼主| 发表于 2021-9-6 10:16 | 显示全部楼层
panliang9 发表于 2021-9-6 09:10
用totalboundary求出外轮廓用时1分36秒。不知道其它方法是多少时间。

啊?这么快吗?我看看这个。
发表于 2021-9-7 09:30 | 显示全部楼层

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

点评

厉害,这个好,这个好  发表于 2021-9-7 10:57
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2020 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2021-10-25 12:18 , Processed in 0.545380 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表