自动生成三角网范围工具求优化

lizhigang78111 · 发表于 2015-4-6 21:58:15

本帖最后由 lizhigang78111 于 2015-4-6 22:11 编辑

以前在本论坛一位好心人替我编的程序用来自动生成三角网范围，以前用的时候三角网数量不多，可以运行。最近发现如果三角网数目较大就出线假死，等很久也完成不了。现发来原程序及三角网CAD 图，供好心人调试试用，选小范围三角网很快，全选就假死，望高手改进一下。谢谢！

lizhigang78111 · 发表于 2015-4-6 21:58:16

原程序发来大家改进

csharp · 发表于 2015-4-6 22:37:03

用xdapi中的函数吧，lisp怎么改效率也不行

lizhigang78111 · 发表于 2015-4-8 10:52:08

希望出手帮助

zml84 · 发表于 2018-10-2 15:14:50

假死，不是数量多的问题。（测试：点选两个不相邻的三角网。）

关键一句在这里：(while (= pdbz nil)。。。

zml84 · 发表于 2018-10-2 16:42:49

(vl-load-com)
(defun c:tt (/ lst_pt bjjc ss lst_en en obj pts p1 p2 p3 tmp)
;;========================
;;边界表
(setq lst_pt '())
;;========================
;;定义函数，边界检查。
(defun bjjc (Xp1 Xp2 / n0 n1 tmp)
(if lst_pt
(progn
(setq n0 (length lst_pt)
tmp (vl-remove-if
(function (lambda (x)
(or (equal x (list Xp2 Xp1) 1e-6)
(equal x (list Xp1 Xp2) 1e-6)
)
)
)
lst_pt
)
n1 (length tmp)
)
(if (= n0 n1)
(setq lst_pt (cons (list Xp1 Xp2) lst_pt))
(setq lst_pt tmp)
)
)
(setq lst_pt (list (list Xp1 Xp2)))
)
)
;;========================
(if (setq ss (ssget '((0 . "POLYLINE") (8 . "SJW") (66 . 1))))
(progn
;;第一步，获取线段表
(setq lst_en (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
(foreach en lst_en
(setq obj (vlax-ename->vla-object en)
pts (vlax-get obj "Coordinates")
p1 (list (car pts) (cadr pts) (caddr pts))
pts (cdr (cdr (cdr pts)))
p2 (list (car pts) (cadr pts) (caddr pts))
p3 (cdr (cdr (cdr pts)))
)
(bjjc p1 p2)
(bjjc p2 p3)
(bjjc p3 p1)
)
;;第二步，逐段绘制
(command "_undo" "be")
(foreach tmp lst_pt
(entmake (list '(0 . "LINE")
'(8 . "0")
(cons 10 (car tmp))
(cons 11 (cadr tmp))
)
)
)
(command "_undo" "e")
)
)
;;========================
;;静默退出
(princ)
)

(vl-load-com) 
(defun c:tt (/ lst_pt bjjc ss lst_en en obj pts p1 p2 p3 tmp) 
  ;;======================== 
  ;;边界表 
  (setq lst_pt '()) 
 
  ;;======================== 
  ;;定义函数，边界检查。 
  (defun bjjc (Xp1 Xp2 / n0 n1 tmp) 
    (if        lst_pt 
      (progn 
        (setq n0  (length lst_pt) 
              tmp (vl-remove-if 
                    (function (lambda (x) 
                                (or (equal x (list Xp2 Xp1) 1e-6) 
                                    (equal x (list Xp1 Xp2) 1e-6) 
                                ) 
                              ) 
                    ) 
                    lst_pt 
                  ) 
              n1  (length tmp) 
        ) 
        (if (= n0 n1) 
          (setq lst_pt (cons (list Xp1 Xp2) lst_pt)) 
          (setq lst_pt tmp) 
        ) 
      ) 
      (setq lst_pt (list (list Xp1 Xp2))) 
    ) 
  ) 
 
  ;;======================== 
  (if (setq ss (ssget '((0 . "POLYLINE") (8 . "SJW") (66 . 1)))) 
    (progn 
      ;;第一步，获取线段表 
      (setq lst_en (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) 
      ) 
      (foreach en lst_en 
        (setq obj (vlax-ename->vla-object en) 
              pts (vlax-get obj "Coordinates") 
              p1  (list (car pts) (cadr pts) (caddr pts)) 
              pts (cdr (cdr (cdr pts))) 
              p2  (list (car pts) (cadr pts) (caddr pts)) 
              p3  (cdr (cdr (cdr pts))) 
        ) 
        (bjjc p1 p2) 
        (bjjc p2 p3) 
        (bjjc p3 p1) 
      ) 
      ;;第二步，逐段绘制 
      (command "_undo" "be") 
      (foreach tmp lst_pt 
        (entmake (list '(0 . "LINE") 
                       '(8 . "0") 
                       (cons 10 (car tmp)) 
                       (cons 11 (cadr tmp)) 
                 ) 
        ) 
      ) 
      (command "_undo" "e") 
    ) 
  ) 
 
  ;;======================== 
  ;;静默退出 
  (princ) 
)

lizhigang78111 · 发表于 2018-10-27 08:45:30

大神修改后的速度解决了但生成的是一段一段的直线，不是封闭的多段线，需要优化呀

marting · 发表于 2018-11-22 12:30:00

lizhigang78111 发表于 2018-10-27 08:45
大神修改后的速度解决了但生成的是一段一段的直线，不是封闭的多段线，需要优化呀

使用XDRX API吧，80万个点，才10秒

具体例子见：

生成三角网
53 个回复 - 1197 次查看
运行在 XDRX API 2017.10.30+ **** 本内容被作者隐藏 ****
2017-10-30 17:45 - newer - 每日插件
晓东API真是爽，生成三角网速度很快
12 个回复 - 434 次查看

2017-1-15 22:32 - zzyong00@163.co - A/VLISP

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

[程序发布] 自动生成三角网范围工具求优化

点评