Spline精确包围盒改进

st788796 · 发表于 2014-12-6 14:44:00

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

ARX http://bbs.xdcad.net/thread-677927-1-1.html
原讨论帖 http://bbs.xdcad.net/thread-671782-1-1.html
改进算法
返回值为 WCS 点(当前 UCS 下盒子)

(defun Spline:Box (obj / cpts vec p1 p2 p4 p3 lst xdir ydir)
(setq cpts (mapcar
'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj))
)
p1 (apply 'mapcar (cons 'min cpts))
p3 (apply 'mapcar (cons 'max cpts))
)
(if (zerop (getvar "worlducs"))
(setq vec (mapcar '- p3 p1)
p2 (mapcar '+ p1 (list (car vec) 0.0 0.0))
p4 (mapcar '+ p1 (list 0.0 (cadr vec) 0.0))
lst (list
(trans p1 0 1)
(trans p2 0 1)
(trans p3 0 1)
(trans p4 0 1)
)
p1 (trans (apply 'mapcar (cons 'min lst)) 1 0)
p3 (trans (apply 'mapcar (cons 'max lst)) 1 0)
xdir (getvar "ucsxdir")
ydir (getvar "ucsydir")
)
(setq xdir '(1.0 0.0 0.0)
ydir '(0.0 1.0 0.0)
)
)
(setq
lst (mapcar '(lambda (a b)
(vlax-curve-getClosestPointToProjection obj a b t)
)
(list p1 p1 p3 p3)
(list xdir ydir xdir ydir)
)
)
(if (zerop (getvar "worlducs"))
(setq lst (mapcar '(lambda (x) (trans x 0 1)) lst))
)
(setq p1 (apply 'mapcar (cons 'min lst))
p3 (apply 'mapcar (cons 'max lst))
)
(mapcar '(lambda (x) (trans x 1 0))
(list p1
(list (car p1) (cadr p3) (caddr p1))
p3
(list (car p3) (cadr p1) (caddr p1))
)
)
)

(defun Spline:Box (obj / cpts vec p1 p2 p4 p3 lst xdir ydir) 
  (setq        cpts (mapcar 
               'cdr 
               (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget obj)) 
             ) 
        p1   (apply 'mapcar (cons 'min cpts)) 
        p3   (apply 'mapcar (cons 'max cpts)) 
  ) 
  (if (zerop (getvar "worlducs")) 
    (setq vec  (mapcar '- p3 p1) 
          p2   (mapcar '+ p1 (list (car vec) 0.0 0.0)) 
          p4   (mapcar '+ p1 (list 0.0 (cadr vec) 0.0)) 
          lst  (list 
                 (trans p1 0 1) 
                 (trans p2 0 1) 
                 (trans p3 0 1) 
                 (trans p4 0 1) 
               ) 
          p1   (trans (apply 'mapcar (cons 'min lst)) 1 0) 
          p3   (trans (apply 'mapcar (cons 'max lst)) 1 0) 
          xdir (getvar "ucsxdir") 
          ydir (getvar "ucsydir") 
    ) 
    (setq xdir '(1.0 0.0 0.0) 
          ydir '(0.0 1.0 0.0) 
    ) 
  ) 
  (setq 
    lst        (mapcar        '(lambda (a b) 
                   (vlax-curve-getClosestPointToProjection obj a b t) 
                 ) 
                (list p1 p1 p3 p3) 
                (list xdir ydir xdir ydir) 
        ) 
  ) 
  (if (zerop (getvar "worlducs")) 
    (setq lst (mapcar '(lambda (x) (trans x 0 1)) lst)) 
  ) 
  (setq        p1 (apply 'mapcar (cons 'min lst)) 
        p3 (apply 'mapcar (cons 'max lst)) 
  ) 
  (mapcar '(lambda (x) (trans x 1 0)) 
          (list        p1 
                (list (car p1) (cadr p3) (caddr p1)) 
                p3 
                (list (car p3) (cadr p1) (caddr p1)) 
          ) 
  ) 
)

测试程序

(defun c:tt (/ e)
(while (setq e (car (xdrx_entsel "\nPick spline: ")))
(apply 'xdrx_polyline_make (cons t (spline:box e)))
)
(princ)
)

/db_自贡黄明儒_ · 发表于 2014-12-8 19:57:27

对椭圆、弧有效吗？

st788796 · 发表于 2014-12-8 19:59:13

/db_自贡黄明儒_ 发表于 2014-12-8 19:57
对椭圆、弧有效吗？

Ellipse 和 ARC 直接用 getboundingbox 即可

熊掌设计 · 发表于 2014-12-9 10:13:59

不错试试先.~~~~~~~~~~~~~~~~~~~~~~~~~`

守仁格竹GM · 发表于 2014-12-9 10:35:55

不是最小包围框，钢结构工具箱里面有，不知道怎么计算的

守仁格竹GM · 发表于 2014-12-9 10:41:49

钢结构工具箱貌似也不是最小，按照楼主这个旋转的话，最终结果一定比那个小

XDSoft · 发表于 2014-12-9 10:42:59

守仁格竹GM 发表于 2014-12-9 10:35
不是最小包围框，钢结构工具箱里面有，不知道怎么计算的

你说的最小包围框是指什么？截个图上来吧。

csharp · 发表于 2014-12-9 11:12:49

守仁格竹GM 发表于 2014-12-9 10:41
钢结构工具箱貌似也不是最小，按照楼主这个旋转的话，最终结果一定比那个小

最小也是用的取模拟点，再用点集去求最小 rectang , spline 本来就是用点描述的，无限逼近，没有极限
z

守仁格竹GM · 发表于 2014-12-9 14:37:06

XDSoft 发表于 2014-12-9 10:42
你说的最小包围框是指什么？截个图上来吧。

如图，黄框为钢结构工具箱计算的最小外接矩形，红框为楼主函数生成的外接矩形。黄框的面积小于红框的面积

但是可以看出黄框也不是最小，没有做到外接。

st788796 · 发表于 2014-12-9 14:55:15

本帖最后由 st788796 于 2014-12-9 14:57 编辑

守仁格竹GM 发表于 2014-12-9 14:37
如图，黄框为钢结构工具箱计算的最小外接矩形，红框为楼主函数生成的外接矩形。黄框的面积小于红框的面积 ...

(defun c:tt (/ e pts box)
(if (setq e (car (xdrx_entsel "\npick spline: " '((0 . "spline")))))
(progn
(setq pts (xdrx_getsamplept e 1e-5)
box (xdrx_points_minareabox pts)
)
(apply 'xdrx_polyline_make (cons t box))
)
)
(princ)
)

这个已经非常接近了，如果嫌不精确
1 再增加采样点密度
2 将这个 BOX 外偏后再用 1 楼方法求精确的盒子

newer · 发表于 2014-12-9 15:10:09

守仁格竹GM 发表于 2014-12-9 14:37
如图，黄框为钢结构工具箱计算的最小外接矩形，红框为楼主函数生成的外接矩形。黄框的面积小于红框的面积 ...

黄的应该是凸包最小面积矩形了，试试用 xdrx_points_minareabox or xdrx_points_minbox 求下看看。

newer · 发表于 2014-12-9 15:12:07

st788796 发表于 2014-12-9 14:55
这个已经非常接近了，如果嫌不精确
1 再增加采样点密度
2 将这个 BOX 外偏后再用 1 楼方法求精确的 ...

这个代码应该是在精度范围内了，足够了。

守仁格竹GM · 发表于 2014-12-9 16:37:09

newer 发表于 2014-12-9 15:10
黄的应该是凸包最小面积矩形了，试试用 xdrx_points_minareabox or xdrx_points_minbox 求下看看。

xdrx_points_minareabox or xdrx_points_minbox
这两个函数没找到呢，加载API没有亮显，帮助也没搜索到，网站也没搜索到{:soso_e103:}

st788796 · 发表于 2014-12-9 16:42:31

守仁格竹GM 发表于 2014-12-9 16:37
xdrx_points_minareabox or xdrx_points_minbox
这两个函数没找到呢，加载API没有亮显，帮助也没搜索到 ...

加群，有最新的API For 2008 x86测试版

st788796 · 发表于 2014-12-10 07:51:10

本帖最后由 st788796 于 2014-12-10 07:54 编辑

守仁格竹GM 发表于 2014-12-9 10:41
钢结构工具箱貌似也不是最小，按照楼主这个旋转的话，最终结果一定比那个小

写了一个对比，用采样点求最小面积包围盒后再扩展求真实包围盒

(defun c:tt (/ e pts box nbox vx vy lst area1 area2)
(if (setq e (car (xdrx_entsel "\npick spline: " '((0 . "spline")))))
(progn
(setq pts (xdrx_getsamplept e 1e-4)
box (xdrx_points_minareabox pts)
nbox (apply 'xdrx_points_offset
(cons (distance (car box) (cadr box))
(xd::pnts:close box)
)
)
vx (mapcar '- (cadr nbox) (car nbox))
vy (mapcar '- (last nbox) (car nbox))
area1 (apply 'xdrx_points_area box)
)
(xdrx_entity_setcolor
(apply 'xdrx_polyline_make (cons t box))
1
)
(setq lst (mapcar
'(lambda (a b)
(vlax-curve-getClosestPointToProjection e a b t)
;;(xdrx_curve_getclosestpoint e a b)
)
(list (car nbox) (car nbox) (caddr nbox) (caddr nbox))
(list vx vy vx vy)
)
lst (list
(inters (car lst)
(mapcar '+ (car lst) vx)
(cadr lst)
(mapcar '+ (cadr lst) vy)
nil
)
(inters (car lst)
(mapcar '+ (car lst) vx)
(last lst)
(mapcar '+ (last lst) vy)
nil
)
(inters (last lst)
(mapcar '+ (last lst) vy)
(caddr lst)
(mapcar '+ (caddr lst) vx)
nil
)
(inters (caddr lst)
(mapcar '+ (caddr lst) vx)
(cadr lst)
(mapcar '+ (cadr lst) vy)
nil
)
)
area2 (apply 'xdrx_points_area lst)
)
(xdrx_entity_setcolor
(apply 'xdrx_polyline_make (cons t lst))
2
)
(xdrx_msgbox
(strcat "采样矢高为 0.001\n"
"采样点数量 = "
(itoa (length pts))
"\nXdRx_Points_MinAreaBox 面积 = "
(rtos area1 2 6)
"\n扩展后真实包围盒面积 = "
(rtos area2 2 6)
"\n误差 = "
(rtos (* (/ (- area2 area1) area1) 100.) 2 6)
"%"
)
"面积对比"
4
0
)
)
)
(princ)
)

(defun c:tt (/ e pts box nbox vx vy lst area1 area2) 
  (if (setq e (car (xdrx_entsel "\npick spline: " '((0 . "spline"))))) 
    (progn 
      (setq pts          (xdrx_getsamplept e 1e-4) 
            box          (xdrx_points_minareabox pts) 
            nbox  (apply 'xdrx_points_offset 
                         (cons (distance (car box) (cadr box)) 
                               (xd::pnts:close box) 
                         ) 
                  ) 
            vx          (mapcar '- (cadr nbox) (car nbox)) 
            vy          (mapcar '- (last nbox) (car nbox)) 
            area1 (apply 'xdrx_points_area box) 
      ) 
      (xdrx_entity_setcolor 
        (apply 'xdrx_polyline_make (cons t box)) 
        1 
      ) 
      (setq lst          (mapcar 
                    '(lambda (a b) 
                        (vlax-curve-getClosestPointToProjection e a b t) 
                       ;;(xdrx_curve_getclosestpoint e a b) 
                     ) 
                    (list (car nbox) (car nbox) (caddr nbox) (caddr nbox)) 
                    (list vx vy vx vy) 
                  ) 
            lst          (list 
                    (inters (car lst) 
                            (mapcar '+ (car lst) vx) 
                            (cadr lst) 
                            (mapcar '+ (cadr lst) vy) 
                            nil 
                    ) 
                    (inters (car lst) 
                            (mapcar '+ (car lst) vx) 
                            (last lst) 
                            (mapcar '+ (last lst) vy) 
                            nil 
                    ) 
                    (inters (last lst) 
                            (mapcar '+ (last lst) vy) 
                            (caddr lst) 
                            (mapcar '+ (caddr lst) vx) 
                            nil 
                    ) 
                    (inters (caddr lst) 
                            (mapcar '+ (caddr lst) vx) 
                            (cadr lst) 
                            (mapcar '+ (cadr lst) vy) 
                            nil 
                    ) 
                  ) 
            area2 (apply 'xdrx_points_area lst) 
      ) 
      (xdrx_entity_setcolor 
        (apply 'xdrx_polyline_make (cons t lst)) 
        2 
      ) 
      (xdrx_msgbox 
        (strcat        "采样矢高为 0.001\n" 
                "采样点数量 = " 
                (itoa (length pts)) 
                "\nXdRx_Points_MinAreaBox 面积 = " 
                (rtos area1 2 6) 
                "\n扩展后真实包围盒面积 = " 
                (rtos area2 2 6) 
                "\n误差 = " 
                (rtos (* (/ (- area2 area1) area1) 100.) 2 6) 
                "%" 
        ) 
        "面积对比" 
        4 
        0 
      ) 
    ) 
  ) 
  (princ) 
)

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

[原创] Spline精确包围盒改进

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评

点评