三角网的改进

Lisphk · 发表于 2014-12-9 20:25:52

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

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

×

今天看了老大的三角网的帖子，http://bbs.xdcad.net/thread-678045-1-1.html试验了下函数： xdrx_points_Delaunay 好像是所有点都连城三角网了，如果下面这样的图

QQ截图20141209202433.png

下面那个是函数生成的三角网，好像函数只支持凸的多边形，另外好像不支持中间有空洞的，怎么才能生成右边那样的三角网呢？

newer · 发表于 2014-12-9 21:16:02

应该不难，在最外面多边形外面生成的3DFACE删除掉，在内部封闭多边形内部的3DFACE删除掉。

st788796 · 发表于 2014-12-9 22:02:14

保存边界收缩点用f选择后删除

Lisphk · 发表于 2014-12-9 22:36:32

st788796 发表于 2014-12-9 22:02
保存边界收缩点用f选择后删除

大师，不会误伤吗？帮写一吧。

st788796 · 发表于 2014-12-10 08:35:27

Lisphk 发表于 2014-12-9 22:36
大师，不会误伤吗？帮写一吧。

简单写了一个，尚需优化

(defun c:tt (/ ss lst alst pts mPnts d cpnts s css)
(if (setq ss (ssget '((0 . "*polyline"))))
(progn
(setq lst (mapcar '(lambda (x)
(xdrx_getpropertyvalue x "area" "vertices")
)
(xdrx_pickset->ents ss)
)
alst (vl-sort lst '(lambda (x1 x2) (> (car x1) (car x2))))
pts (apply 'append (mapcar 'cadr lst))
)
(setq css (xdrx_points_delaunay pts t))
(setq mPnts (cadar alst)
d (if (minusp (apply 'xdrx_points_area mPnts))
-10
10;_可调数据
)
cPnts (apply 'xdrx_points_offset
(cons d
(xd::pnts:close mPnts)
)
)
)
(xdrx_object_regen);_速度太快，可能 3dface 还没有显示，不生成后面无法选择到
(if (setq ss (ssget "F" cpnts '((0 . "3dface"))))
(xdrx_entity_delete ss)
)
(if (setq ss (ssget "WP" mPnts '((0 . "*Polyline"))))
(progn
(setq iLst
(mapcar '(lambda (x / cpts)
(setq
cpts (if (xdrx_curve_direction x)
(xdrx_getpropertyvalue x "vertices")
(reverse
(xdrx_getpropertyvalue x "vertices")
)
)
)
(apply 'xdrx_points_offset
(cons -1 (xd::pnts:close cpts))
)
)
(xdrx_pickset->ents ss)
)
)
(foreach x iLst
(if (setq s (ssget "F" x '((0 . "3dface"))))
(xdrx_entity_delete s)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ ss lst alst pts mPnts d cpnts s css) 
  (if (setq ss (ssget '((0 . "*polyline")))) 
    (progn 
      (setq lst         (mapcar '(lambda (x) 
                            (xdrx_getpropertyvalue x "area" "vertices") 
                          ) 
                         (xdrx_pickset->ents ss) 
                 ) 
            alst (vl-sort lst '(lambda (x1 x2) (> (car x1) (car x2)))) 
            pts         (apply 'append (mapcar 'cadr lst)) 
      ) 
      (setq css (xdrx_points_delaunay pts t)) 
      (setq mPnts (cadar alst) 
            d          (if (minusp (apply 'xdrx_points_area mPnts)) 
                    -10 
                    10;_可调数据 
                  ) 
            cPnts (apply 'xdrx_points_offset 
                         (cons d 
                               (xd::pnts:close mPnts) 
                         ) 
                  ) 
      ) 
      (xdrx_object_regen);_速度太快，可能 3dface 还没有显示，不生成后面无法选择到 
      (if (setq ss (ssget "F" cpnts '((0 . "3dface")))) 
        (xdrx_entity_delete ss) 
      ) 
      (if (setq ss (ssget "WP" mPnts '((0 . "*Polyline")))) 
        (progn 
          (setq        iLst 
                 (mapcar '(lambda (x / cpts) 
                            (setq 
                              cpts (if (xdrx_curve_direction x) 
                                     (xdrx_getpropertyvalue x "vertices") 
                                     (reverse 
                                       (xdrx_getpropertyvalue x "vertices") 
                                     ) 
                                   ) 
                            ) 
                            (apply 'xdrx_points_offset 
                                   (cons -1 (xd::pnts:close cpts)) 
                            ) 
                          ) 
                         (xdrx_pickset->ents ss) 
                 ) 
          ) 
          (foreach x iLst 
            (if        (setq s (ssget "F" x '((0 . "3dface")))) 
              (xdrx_entity_delete s) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

Lisphk · 发表于 2014-12-10 08:58:09

st788796 发表于 2014-12-10 08:35
简单写了一个，尚需优化

大师，看图，好像删除的多了，还有没删除掉的。
QQ截图20141210085649.png

st788796 · 发表于 2014-12-10 09:33:47

Lisphk 发表于 2014-12-10 08:58
大师，看图，好像删除的多了，还有没删除掉的。

wp选择时应该将点表内偏或者去掉面积最大的，外侧漏掉的应该是外偏距离过大了

st788796 · 发表于 2014-12-10 11:37:15

Lisphk 发表于 2014-12-10 08:58
大师，看图，好像删除的多了，还有没删除掉的。

再试试这个

(defun c:tt (/ ss lst alst pts mPnts d cpnts s css mind hpnts tf)
(defun _Pnts:Offset (pts mod / area lpts mind cpts)
(setq area (apply 'xdrx_points_area pts)
cpts (xd::pnts:close pts)
lpts (xd::list:snakepair cpts)
mind (car
(vl-sort (mapcar '(lambda (x) (apply 'distance x)) lpts)
'<
)
)
)
(if mod ;_outside
(if (minusp area)
(apply 'xdrx_points_offset (cons (- (/ mind 10.0)) cpts))
(apply 'xdrx_points_offset (cons (/ mind 10.0) cpts))
)
(if (minusp area)
(apply 'xdrx_points_offset (cons (/ mind 10.0) cpts))
(apply 'xdrx_points_offset (cons (- (/ mind 10.0)) cpts))
)
)
)
(if (setq ss (ssget '((0 . "*polyline"))))
(progn
(setq lst (mapcar '(lambda (x)
(xdrx_getpropertyvalue x "area" "vertices")
)
(setq plst (xdrx_pickset->ents ss))
)
alst (vl-sort lst '(lambda (x1 x2) (> (car x1) (car x2))))
pts (apply 'append (mapcar 'cadr lst))
)
(setq css (xdrx_points_delaunay pts t))
(setq mPnts (cadar alst)
hPnts (xdrx_points_ghull mPnts)
)
(if (< (apply 'xdrx_points_area mPnts)
(apply 'xdrx_points_area hPnts)
)
(progn
(xdrx_sysvar_push '("osmode" 0))
(xdrx_object_regen) ;_速度太快，可能 3dface 还没有显示，不生成后面无法选择到
(if
(setq
ss1 (ssget "F" (_Pnts:Offset mpnts t) '((0 . "3dface")))
)
(xdrx_entity_delete ss1)
)
)
)
(if (> (length plst) 1)
(progn
(setq plst (cdr (vl-sort plst
'(lambda (x1 x2)
(> (car (xdrx_getarea x1))
(car (xdrx_getarea x2))
)
)
)
)
)
(if (not tf)
(xdrx_object_regen)
)
(foreach x plst
(setq iLst (xdrx_getpropertyvalue x "vertices"))
(if (setq s (ssget "F"
(_Pnts:Offset iLst nil)
'((0 . "3dface"))
)
)
(xdrx_entity_delete s)
)
)
)
)
)
)
(xdrx_sysvar_pop)
(princ)
)

(defun c:tt (/ ss lst alst pts mPnts d cpnts s css mind hpnts tf) 
  (defun _Pnts:Offset (pts mod / area lpts mind cpts) 
    (setq area (apply 'xdrx_points_area pts) 
          cpts (xd::pnts:close pts) 
          lpts (xd::list:snakepair cpts) 
          mind (car 
                 (vl-sort (mapcar '(lambda (x) (apply 'distance x)) lpts) 
                          '< 
                 ) 
               ) 
    ) 
    (if        mod ;_outside 
      (if (minusp area) 
        (apply 'xdrx_points_offset (cons (- (/ mind 10.0)) cpts)) 
        (apply 'xdrx_points_offset (cons (/ mind 10.0) cpts)) 
      ) 
      (if (minusp area) 
        (apply 'xdrx_points_offset (cons (/ mind 10.0) cpts)) 
        (apply 'xdrx_points_offset (cons (- (/ mind 10.0)) cpts)) 
      ) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "*polyline")))) 
    (progn 
      (setq lst         (mapcar '(lambda (x) 
                            (xdrx_getpropertyvalue x "area" "vertices") 
                          ) 
                         (setq plst (xdrx_pickset->ents ss)) 
                 ) 
            alst (vl-sort lst '(lambda (x1 x2) (> (car x1) (car x2)))) 
            pts         (apply 'append (mapcar 'cadr lst)) 
      ) 
      (setq css (xdrx_points_delaunay pts t)) 
      (setq mPnts (cadar alst) 
            hPnts (xdrx_points_ghull mPnts) 
      ) 
      (if (< (apply 'xdrx_points_area mPnts) 
             (apply 'xdrx_points_area hPnts) 
          ) 
        (progn 
          (xdrx_sysvar_push '("osmode" 0)) 
          (xdrx_object_regen) ;_速度太快，可能 3dface 还没有显示，不生成后面无法选择到 
          (if 
            (setq 
              ss1 (ssget "F" (_Pnts:Offset mpnts t) '((0 . "3dface"))) 
            ) 
             (xdrx_entity_delete ss1) 
          ) 
        ) 
      ) 
      (if (> (length plst) 1) 
        (progn 
          (setq        plst (cdr (vl-sort plst 
                                   '(lambda (x1 x2) 
                                      (> (car (xdrx_getarea x1)) 
                                         (car (xdrx_getarea x2)) 
                                      ) 
                                    ) 
                          ) 
                     ) 
          ) 
 
          (if (not tf) 
            (xdrx_object_regen) 
          ) 
          (foreach x plst 
            (setq iLst (xdrx_getpropertyvalue x "vertices")) 
            (if        (setq s        (ssget "F" 
                               (_Pnts:Offset iLst nil) 
                               '((0 . "3dface")) 
                        ) 
                ) 
              (xdrx_entity_delete s) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (princ) 
)

st788796 · 发表于 2014-12-10 12:15:23

还是啰嗦了，用选集的交并差即可

st788796 · 发表于 2014-12-10 14:38:41

newer 发表于 2014-12-9 21:16
应该不难，在最外面多边形外面生成的3DFACE删除掉，在内部封闭多边形内部的3DFACE删除掉。

又试了一次，不是删除那么简单，这种是有约束边的三角网，有越界的三角！

(defun c:tt (/ ss lst alst pts s1 s2)
(defun _Pnts:Offset (pts mod / area lpts mind cpts)
(setq area (apply 'xdrx_points_area pts)
cpts (xd::pnts:close pts)
lpts (xd::list:snakepair cpts)
mind (car
(vl-sort (mapcar '(lambda (x) (apply 'distance x)) lpts)
'<
)
)
)
(if mod ;_outside
(if (minusp area)
(apply 'xdrx_points_offset (cons (- (/ mind 10.0)) cpts))
(apply 'xdrx_points_offset (cons (/ mind 10.0) cpts))
)
(if (minusp area)
(apply 'xdrx_points_offset (cons (/ mind 10.0) cpts))
(apply 'xdrx_points_offset (cons (- (/ mind 10.0)) cpts))
)
)
)
(if (setq ss (ssget '((0 . "*polyline"))))
(progn
(setq lst (mapcar '(lambda (x)
(xdrx_getpropertyvalue x "area" "vertices")
)
(setq plst (xdrx_pickset->ents ss))
)
alst (vl-sort lst '(lambda (x1 x2) (> (car x1) (car x2))))
pts (apply 'append (mapcar 'cadr lst))
)
(xdrx_setmark)
(xdrx_points_delaunay pts t)
(xdrx_entity_setcolor (xdrx_getss) 9)
(xdrx_object_regen)
(if (setq s1 (xdrx_pickset_subtract
(xdrx_getss)
(ssget "CP"
(_Pnts:Offset (cadar alst) nil)
'((0 . "3dface"))
)
)
)
(xdrx_entity_delete s1)
)
(if (cdr alst)
(progn
(foreach x (mapcar 'cadr (cdr alst))
(if
(setq
s2 (ssget "CP" (_Pnts:Offset x nil) '((0 . "3dface")))
)
(xdrx_entity_delete s2)
)
)
)
)
(xdrx_draworder->top ss)
)
(xdrx_sysvar_pop)
)
(princ)
)

(defun c:tt (/ ss lst alst pts s1 s2) 
  (defun _Pnts:Offset (pts mod / area lpts mind cpts) 
    (setq area (apply 'xdrx_points_area pts) 
          cpts (xd::pnts:close pts) 
          lpts (xd::list:snakepair cpts) 
          mind (car 
                 (vl-sort (mapcar '(lambda (x) (apply 'distance x)) lpts) 
                          '< 
                 ) 
               ) 
    ) 
    (if        mod ;_outside 
      (if (minusp area) 
        (apply 'xdrx_points_offset (cons (- (/ mind 10.0)) cpts)) 
        (apply 'xdrx_points_offset (cons (/ mind 10.0) cpts)) 
      ) 
      (if (minusp area) 
        (apply 'xdrx_points_offset (cons (/ mind 10.0) cpts)) 
        (apply 'xdrx_points_offset (cons (- (/ mind 10.0)) cpts)) 
      ) 
    ) 
  ) 
 
  (if (setq ss (ssget '((0 . "*polyline")))) 
    (progn 
      (setq lst         (mapcar '(lambda (x) 
                            (xdrx_getpropertyvalue x "area" "vertices") 
                          ) 
                         (setq plst (xdrx_pickset->ents ss)) 
                 ) 
            alst (vl-sort lst '(lambda (x1 x2) (> (car x1) (car x2)))) 
            pts         (apply 'append (mapcar 'cadr lst)) 
      ) 
      (xdrx_setmark) 
      (xdrx_points_delaunay pts t) 
      (xdrx_entity_setcolor (xdrx_getss) 9) 
      (xdrx_object_regen) 
      (if (setq        s1 (xdrx_pickset_subtract 
                     (xdrx_getss) 
                     (ssget "CP" 
                            (_Pnts:Offset (cadar alst) nil) 
                            '((0 . "3dface")) 
                     ) 
                   ) 
          ) 
        (xdrx_entity_delete s1) 
      ) 
      (if (cdr alst) 
        (progn 
          (foreach x (mapcar 'cadr (cdr alst)) 
            (if 
              (setq 
                s2 (ssget "CP" (_Pnts:Offset x nil) '((0 . "3dface"))) 
              ) 
               (xdrx_entity_delete s2) 
            ) 
          ) 
        ) 
      ) 
      (xdrx_draworder->top ss) 
    ) 
    (xdrx_sysvar_pop) 
  ) 
  (princ) 
)

Lisphk · 发表于 2014-12-10 15:48:06

st788796 发表于 2014-12-10 14:38
又试了一次，不是删除那么简单，这种是有约束边的三角网，有越界的三角！

{:soso_e114:}什么是越界的三角形？

st788796 · 发表于 2014-12-10 16:02:41

有约束边了就要进行局部优化，如图示两个红色三角

newer · 发表于 2014-12-10 16:19:44

Lisphk 发表于 2014-12-10 08:58
大师，看图，好像删除的多了，还有没删除掉的。

试试这个，如果有漏网或者误杀的再修改。

(defun c:tt (/ )
(if (setq ss (ssget '((0 . "*polyline") (70 . 1))))
(progn
(xdrx_begin)
(setq lst (mapcar
'(lambda (x)
(xdrx_getpropertyvalue x "area" "vertices")
(list (xdrx_getpropertyvalue x "area") x (xdrx_getpropertyvalue x "vertices"))
)
(setq ents(xdrx_pickset->ents ss))
)
lst (vl-sort lst '(lambda (x1 x2)
(> (car x1) (car x2))
)
)
alst (vl-sort lst '(lambda (x1 x2)
(> (car x1) (car x2))
)
)
maxent (cadar alst)
ents1 (XD::List:RemoveE maxent ents t)
pts (apply
'append
(mapcar
'last
lst
)
)
)
(setq css (xdrx_points_delaunay pts t))
(mapcar
'(lambda (x)
(setq vertices (xdrx_getpropertyvalue x "vertices")
heartpnt (XD::Geom:Triangleheart (car vertices)(cadr vertices)(caddr vertices))
)
(if (> (length(xdrx_entity_intersectwith x maxent)) 2)
(progn
(entdel x)
)
)
(mapcar '(lambda(y)(if (> (length(xdrx_entity_intersectwith y x)) 2)(entdel x)))ents1)
)
(xdrx_pickset->ents css)
)
(xdrx_end)
)
)
(princ)
)

(defun c:tt (/ ) 
  (if (setq ss (ssget '((0 . "*polyline") (70 . 1)))) 
    (progn 
      (xdrx_begin) 
      (setq lst (mapcar 
                  '(lambda (x) 
                     (xdrx_getpropertyvalue x "area" "vertices") 
                     (list (xdrx_getpropertyvalue x "area") x (xdrx_getpropertyvalue x "vertices")) 
                   ) 
                  (setq ents(xdrx_pickset->ents ss)) 
                ) 
            lst (vl-sort lst '(lambda (x1 x2) 
                                 (> (car x1) (car x2)) 
                               ) 
                 ) 
            alst (vl-sort lst '(lambda (x1 x2) 
                                 (> (car x1) (car x2)) 
                               ) 
                 ) 
            maxent (cadar alst) 
            ents1 (XD::List:RemoveE maxent ents t) 
            pts (apply 
                  'append 
                  (mapcar 
                    'last 
                    lst 
                  ) 
                ) 
      ) 
      (setq css (xdrx_points_delaunay pts t)) 
      (mapcar 
        '(lambda (x) 
           (setq vertices (xdrx_getpropertyvalue x "vertices") 
                 heartpnt (XD::Geom:Triangleheart (car vertices)(cadr vertices)(caddr vertices)) 
           ) 
           (if (> (length(xdrx_entity_intersectwith x maxent)) 2) 
             (progn 
              (entdel x) 
             ) 
           ) 
           (mapcar '(lambda(y)(if (> (length(xdrx_entity_intersectwith y x)) 2)(entdel x)))ents1)            
         ) 
        (xdrx_pickset->ents css) 
      ) 
      (xdrx_end) 
    ) 
 
  ) 
  (princ) 
)

st788796 · 发表于 2014-12-10 16:46:48

newer 发表于 2014-12-10 16:19
试试这个，如果有漏网或者误杀的再修改。

改过了？我用的 css 是返回 T，不是selectionset

newer · 发表于 2014-12-10 16:52:01

st788796 发表于 2014-12-10 16:46
改过了？我用的 css 是返回 T，不是selectionset

提建议，老大今天修改的，我这是新的。

QQ截图20141210164921.png

上面是凸多边形的，我认为还是限制下只凸的，凹的情况很多要判断处理。ST你接着研究下带凹的吧。

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

[编程申请] 三角网的改进

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

点评

点评

点评

点评

点评