点表连线求最优算法

edata · 发表于 2015-8-26 10:26

(foreach x lst
==>(foreach x (cdr lsts)
难道你没发现？？？，这句改了，就没重线了。

vlisp2012 · 发表于 2015-8-26 13:17

陨落发表于 2015-8-30 05:16
犀牛里面有很多插件，可以直接划分三维网格，结合其三维投影等强大的三维功能，是为做网架之必备神器

陨落兄，你说的犀牛插件，是grasshopper里的？还是犀牛的插件，能提供下插件的名称吗？

陨落 · 发表于 2015-8-26 15:31

vlisp2012 发表于 2015-8-26 13:17
陨落兄，你说的犀牛插件，是grasshopper里的？还是犀牛的插件，能提供下插件的名称吗？

最常用的是paneling tools。其他还有很多专门做网架用的

陨落 · 发表于 2015-8-30 14:06

犀牛的教程很多，百度即可，我最近太忙了，实在抽不出时间来做教程

nzl1116 · 发表于 2015-11-12 20:17

这个楼主自己解决了吗？

nzl1116 · 发表于 2015-11-13 09:55

(defun AYL-Points (myFunction / PntLst ss)
(if (setq ss (ssget))
(progn
(setq PntLst (AYL-ss->PntLst ss))
(setq ss nil)
(cond
((caddr PntLst)
(foreach x (myFunction PntLst)
(entmake (list '(0 . "Line") (cons 10 (car x)) (cons 11 (cadr x))))
)
)
((cadr PntLst)
(entmake (list '(0 . "Line") (cons 10 (car PntLst)) (cons 11 (cadr PntLst))))
)
(t nil)
)
)
(princ "\n选择了0个对象")
)
(princ)
)
(defun AYL-ss->PntLst (ss / PntLst n)
(setq PntLst nil)
(repeat (setq n (sslength ss))
(setq PntLst (cons (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))) PntLst))
)
)
(defun AYL-Points-Mesh2 (PntLst / TmpLst tttLst Point RetLst CuLine Points bbbLst tt0Lst *Bcde*)
(setq TmpLst (AYL-Points->Lines PntLst))
(setq Point (caar TmpLst))
(setq PntLst (vl-remove Point PntLst))
(setq RetLst nil
tttLst nil
Points (list Point)
)
(while TmpLst
(setq CuLine (car TmpLst))
(if (AYL-isInters CuLine RetLst)
nil
(progn
(setq RetLst (cons CuLine RetLst)
tttLst (cons CuLine tttLst)
bbbLst nil
)
(while Points
(setq Point (car Points))
(setq Points (cdr Points))
(setq tt0Lst nil)
(foreach x tttLst
(if (member Point x)
(progn
(setq tttLst (vl-remove x tttLst))
(setq tt0Lst (cons (car (vl-remove Point x)) tt0Lst))
)
)
)
(if tt0Lst
(progn
(foreach x tt0Lst (setq PntLst (vl-remove x PntLst)))
(setq Points (append Points tt0Lst))
)
)
(setq bbbLst (cons Point bbbLst))
)
(setq Points bbbLst)
(if (and (not PntLst) (= Integ0 Number))
(setq *Bcde* TmpLst TmpLst nil)
)
)
)
(setq TmpLst (cdr TmpLst))
)
(while (and (setq CuLine (car *Bcde*))
(equal (apply 'distance (car RetLst)) (apply 'distance CuLine) 0.000001)
)
(if (AYL-isInters CuLine RetLst)
nil
(setq RetLst (cons CuLine RetLst))
)
(setq *Bcde* (cdr *Bcde*))
)
RetLst
)
(defun AYL-isInters (CuLine tttLst / TorNil Point0 Point1 Point2 Point3 *Bcde*)
(setq TorNil nil)
(setq Point0 (car CuLine))
(setq Point1 (cadr CuLine))
(while tttLst
(setq Point2 (caar tttLst))
(setq Point3 (cadar tttLst))
;;两直线相交，但不是首尾相连
(if (and (inters Point0 Point1 Point2 Point3)
(not (equal (distance Point0 Point2) 0 0.000001))
(not (equal (distance Point0 Point3) 0 0.000001))
(not (equal (distance Point1 Point2) 0 0.000001))
(not (equal (distance Point1 Point3) 0 0.000001))
)
(setq TorNil t tttLst nil)
(setq tttLst (cdr tttLst))
)
)
TorNil
)
(defun AYL-Points->Lines (PntLst / RetLst Point)
(setq RetLst nil)
(while (cadr PntLst)
(setq Point (car PntLst))
(foreach x (setq PntLst (cdr PntLst))
(setq RetLst (cons (list Point x) RetLst))
)
)
(vl-sort RetLst (function (lambda (x y) (< (apply 'distance x) (apply 'distance y)))))
)
(defun c:ttt3 ()
(AYL-Points AYL-Points-Mesh2)
)

(defun AYL-Points (myFunction / PntLst ss) 
  (if (setq ss (ssget)) 
    (progn 
      (setq PntLst (AYL-ss->PntLst ss)) 
      (setq ss nil) 
      (cond 
        ((caddr PntLst) 
         (foreach x (myFunction PntLst) 
           (entmake (list '(0 . "Line") (cons 10 (car x)) (cons 11 (cadr x)))) 
         ) 
        ) 
        ((cadr PntLst) 
         (entmake (list '(0 . "Line") (cons 10 (car PntLst)) (cons 11 (cadr PntLst)))) 
        ) 
        (t nil) 
      ) 
    ) 
    (princ "\n选择了0个对象") 
  ) 
  (princ) 
) 
(defun AYL-ss->PntLst (ss / PntLst n) 
  (setq PntLst nil) 
  (repeat (setq n (sslength ss)) 
    (setq PntLst (cons (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))) PntLst)) 
  ) 
) 
(defun AYL-Points-Mesh2 (PntLst / TmpLst tttLst Point RetLst CuLine Points bbbLst tt0Lst *Bcde*) 
  (setq TmpLst (AYL-Points->Lines PntLst)) 
  (setq Point (caar TmpLst)) 
  (setq PntLst (vl-remove Point PntLst)) 
  (setq RetLst nil 
        tttLst nil 
        Points (list Point) 
  ) 
  (while TmpLst 
    (setq CuLine (car TmpLst)) 
    (if (AYL-isInters CuLine RetLst) 
      nil 
      (progn 
        (setq RetLst (cons CuLine RetLst) 
              tttLst (cons CuLine tttLst) 
              bbbLst nil 
        ) 
        (while Points 
          (setq Point (car Points)) 
          (setq Points (cdr Points)) 
          (setq tt0Lst nil) 
          (foreach x tttLst 
            (if (member Point x) 
              (progn 
                (setq tttLst (vl-remove x tttLst)) 
                (setq tt0Lst (cons (car (vl-remove Point x)) tt0Lst)) 
              ) 
            ) 
          ) 
          (if tt0Lst 
            (progn 
              (foreach x tt0Lst (setq PntLst (vl-remove x PntLst))) 
              (setq Points (append Points tt0Lst)) 
            ) 
          ) 
          (setq bbbLst (cons Point bbbLst)) 
        ) 
        (setq Points bbbLst) 
        (if (and (not PntLst) (= Integ0 Number)) 
          (setq *Bcde* TmpLst TmpLst nil) 
        ) 
      ) 
    ) 
    (setq TmpLst (cdr TmpLst)) 
  ) 
  (while (and (setq CuLine (car *Bcde*)) 
              (equal (apply 'distance (car RetLst)) (apply 'distance CuLine) 0.000001) 
         ) 
    (if (AYL-isInters CuLine RetLst) 
      nil 
      (setq RetLst (cons CuLine RetLst)) 
    ) 
    (setq *Bcde* (cdr *Bcde*)) 
  ) 
  RetLst 
) 
(defun AYL-isInters (CuLine tttLst / TorNil Point0 Point1 Point2 Point3 *Bcde*) 
  (setq TorNil nil) 
  (setq Point0 (car CuLine)) 
  (setq Point1 (cadr CuLine)) 
  (while tttLst 
    (setq Point2 (caar tttLst)) 
    (setq Point3 (cadar tttLst)) 
    ;;两直线相交，但不是首尾相连 
    (if (and (inters Point0 Point1 Point2 Point3) 
             (not (equal (distance Point0 Point2) 0 0.000001)) 
             (not (equal (distance Point0 Point3) 0 0.000001)) 
             (not (equal (distance Point1 Point2) 0 0.000001)) 
             (not (equal (distance Point1 Point3) 0 0.000001)) 
        ) 
      (setq TorNil t tttLst nil) 
      (setq tttLst (cdr tttLst)) 
    ) 
  ) 
  TorNil 
) 
(defun AYL-Points->Lines (PntLst / RetLst Point) 
  (setq RetLst nil) 
  (while (cadr PntLst) 
    (setq Point (car PntLst)) 
    (foreach x (setq PntLst (cdr PntLst)) 
      (setq RetLst (cons (list Point x) RetLst)) 
    ) 
  ) 
  (vl-sort RetLst (function (lambda (x y) (< (apply 'distance x) (apply 'distance y))))) 
) 
(defun c:ttt3 () 
  (AYL-Points AYL-Points-Mesh2) 
)

nzl1116 · 发表于 2015-11-13 12:18

就是从最小长度开始连，然后不断增加这个长度，一直到所有的点都连在一起为止。

xyccf · 发表于 2015-11-13 15:39

已解决，请问怎么解决的？

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

[已解答] 点表连线求最优算法

点评

点评

点评

点评

评分

点评

点评