Automatic numbering in air flow order

Dear all,

I am looking for a lisp for Automatic numbering in air flow order.

I have air flow diagram with branches (Scheme-3-numbering procedure.dwg) drawn by polylines where each polyline represents branch with specific air flow.

Each polyline has block with attributes that identify branches.

I need to make numbering of "CU" attribute in order of air flow.

Based on that numbering I am able to calculate air flow for common branches and calculate size of ducts for each branch (Dimensioning.xlsx)

Dimensioning.xlsx

Scheme-3-numbering procedure.dwg

What exactly do you want to automate?

1) numbering:

Who inserts the dn_cu blocks?

Who draws the arrows?

Is the routine supposed to calculate that the last line is numbered 15 (*) ?

Or does the user/client have to click on line 1, then click on line 2, ... ?

---

I think once "2. Initial numbering of branches" is finished the hard part is over

Also, your polyline 11 is two polylines. It should be one.

(* actually that sounds fun to try. The user selects the trunk of the tree structure, then a recursive function detects the tree tructure and numbers the branches. It's all doable)

What exactly do you want to automate?

 

1) numbering:

Who inserts the dn_cu blocks?

Who draws the arrows?

 

Is the routine supposed to calculate that the last line is numbered 15?

Or does the user/client have to click on line 1, then click on line 2, ... ?

 

---

I think once "2. Initial numbering of branches" is finished the hard part is over

I insert the dn_cu blocks to all mid points of brances by lisp.

I do not need arrows, they are there just for visualisation and description.

So I insert dn_cu blocks with blank attributes and than I need processing the numbering.

I can select e.g. first branch and last branch (nr. 15) but the rest I expect from routine.

Currently I do it by click one by one for initial numbering and again for secondary numbering.

We do something similar for storm water drainage with auto numbering, dont have anything some one smarter than me has worked it out, but suggest googling for "tree" labeling in lisp as this is what its like, you go up the trunk with branches get to an end go back to trunk find next branch and so on.

Browsing and numbering the tree structure actually works. Try this out.

The script writes a text entity at one end of the polyline (the opposite endpoint as where it started searching)

Notice: you do need a clean tree structure.

The connections need to be (o)snapped, I expect each branch to be 1 polyline, not 2 in series.

.. and of course it has to be a tree. No loops!

I left a dwg as attachment

pline_tree.dwg

Notice: you can pick any endpoint as the trunk of the tree (topologically a tree keeps being a tree whichever trunk you pick)

;; @file 
;;  - Detect a tree structure
;;  - Number the branches
;;  (- add stuff to attributes, not really included in this file)
;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order
         
(defun Text (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))

;;; 2d-coord->pt-lst
;; Converts a 2d coordinates flat list into a 2d point list
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0))
(defun 2d-coord->pt-lst (lst)
 (if lst
   (cons (list (car lst) (cadr lst))
     (2d-coord->pt-lst (cddr lst))
   )
 )
)

(defun getLast (mylist)
 (nth (- (length mylist) 1) mylist)
)

(setq indexHandled (list))
(defun BTS (ss pt0 / i pts d1 d2 mypoint mystring)
 (setq i 0)
 (repeat (sslength ss)
     (setq pl (vlax-ename->vla-object (ssname ss i)))
     ;; get its vertices list
     (setq pts (2d-coord->pt-lst (vlax-get pl 'coordinates))) 
       
     (setq d1 (distance (setq mypoint (nth 0 pts)) pt0) )
     (setq d2 (distance (setq mypoint (getLast pts)) pt0) )
     
     ;; counting ascending
     ;;(setq mystring (rtos (length indexHandled) 2 0))
     ;; counting descending
     (setq mystring (rtos (- (sslength ss) (length indexHandled)) 2 0))
   
     (if (not (member i indexHandled)) (progn
   (if (< d1 0.000001) (progn
     (setq indexHandled (append indexHandled (list i)))
     (Text mypoint 2.5 mystring)
     (bts ss (getLast pts))
   ))
   (if (< d2 0.000001) (progn
       (setq indexHandled (append indexHandled (list i)))
     (Text mypoint 2.5 mystring)
     (bts ss (nth 0 pts))
       ))
     )
   )
   (setq i (+ i 1 ))
 )
)

(defun c:BTS ( / ss index trunk pt0)
 (setq indexHandled (list))  ;; reset which branches have been handled yet
 (setq ss (ssget ":L" '((0 . "LWPOLYLINE,POLYLINE"))))
 (setq pt0 (osnap (getpoint "\nSelect the trunk <osnap on the base of the trunk>: ") "_end"))
 (BTS ss pt0)
)

Browsing and numbering the tree structure actually works. Try this out.

The script writes a text entity at one end of the polyline (the opposite endpoint as where it started searching)

 

Notice: you do need a clean tree structure.

The connections need to be (o)snapped, I expect each branch to be 1 polyline, not 2 in series.

.. and of course it has to be a tree. No loops!

 

I left a dwg as attachment

[ATTACH]64263[/ATTACH]

 

Notice: you can pick any endpoint as the trunk of the tree (topologically a tree keeps being a tree whichever trunk you pick)

 

;; @file 
;;  - Detect a tree structure
;;  - Number the branches
;;  (- add stuff to attributes, not really included in this file)
;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order
         
(defun Text (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))

;;; 2d-coord->pt-lst
;; Converts a 2d coordinates flat list into a 2d point list
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0))
(defun 2d-coord->pt-lst (lst)
 (if lst
   (cons (list (car lst) (cadr lst))
     (2d-coord->pt-lst (cddr lst))
   )
 )
)

(defun getLast (mylist)
 (nth (- (length mylist) 1) mylist)
)

(setq indexHandled (list))
(defun BTS (ss pt0 / i pts d1 d2 mypoint mystring)
 (setq i 0)
 (repeat (sslength ss)
     (setq pl (vlax-ename->vla-object (ssname ss i)))
     ;; get its vertices list
     (setq pts (2d-coord->pt-lst (vlax-get pl 'coordinates))) 
       
     (setq d1 (distance (setq mypoint (nth 0 pts)) pt0) )
     (setq d2 (distance (setq mypoint (getLast pts)) pt0) )
     
     ;; counting ascending
     ;;(setq mystring (rtos (length indexHandled) 2 0))
     ;; counting descending
     (setq mystring (rtos (- (sslength ss) (length indexHandled)) 2 0))
   
     (if (not (member i indexHandled)) (progn
   (if (< d1 0.000001) (progn
     (setq indexHandled (append indexHandled (list i)))
     (Text mypoint 2.5 mystring)
     (bts ss (getLast pts))
   ))
   (if (< d2 0.000001) (progn
       (setq indexHandled (append indexHandled (list i)))
     (Text mypoint 2.5 mystring)
     (bts ss (nth 0 pts))
       ))
     )
   )
   (setq i (+ i 1 ))
 )
)

(defun c:BTS ( / ss index trunk pt0)
 (setq indexHandled (list))  ;; reset which branches have been handled yet
 (setq ss (ssget ":L" '((0 . "LWPOLYLINE,POLYLINE"))))
 (setq pt0 (osnap (getpoint "\nSelect the trunk <osnap on the base of the trunk>: ") "_end"))
 (BTS ss pt0)
)

Wow, perfect.

I had no idea how to process it.

Super inspiration, thank you very much.

Have you seen Lee's chain select? Seems like you could use this to number your segments.

Try this quick mod:

;;--------------------=={ Chain Selection }==-----------------;;
;;                                                            ;;
;;  Prompts the user to select an object and generates a      ;;
;;  selection chain of all objects sharing endpoints with     ;;
;;  objects in the accumulative selection.                    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;; RJP addtions below
(defun c:cs (/ en fl in l l1 l2 n s1 s2 sf vl)
 (setq	sf (list '(-4 . "<OR")
	 '(0 . "LINE,ARC")
	 '(-4 . "<AND")
	 '(0 . "LWPOLYLINE,SPLINE")
	 '(-4 . "<NOT")
	 '(-4 . "&=")
	 '(70 . 1)
	 '(-4 . "NOT>")
	 '(-4 . "AND>")
	 '(-4 . "<AND")
	 '(0 . "POLYLINE")
	 '(-4 . "<NOT")
	 '(-4 . "&")
	 '(70 . 89)
	 '(-4 . "NOT>")
	 '(-4 . "AND>")
	 '(-4 . "<AND")
	 '(0 . "ELLIPSE")
	 '(-4 . "<OR")
	 '(-4 . "<>")
	 '(41 . 0.0)
	 '(-4 . "<>")
	 (cons 42 (+ pi pi))
	 '(-4 . "OR>")
	 '(-4 . "AND>")
	 '(-4 . "OR>")
	 (if (= 1 (getvar 'cvport))
	   (cons 410 (getvar 'ctab))
	   '(410 . "Model")
	 )
   )
 )
 (if (setq s1 (ssget "_X" sf))
   (if	(setq en (ssget "_+.:E:S" sf))
     (progn
(setq s2 (ssadd)
      en (ssname en 0)
      l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
)
(repeat	(setq in (sslength s1))
  (setq	en (ssname s1 (setq in (1- in)))
	vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
  )
)
(while
  (progn
    (foreach v vl
      (if (vl-some '(lambda (p) (or (equal (car v) p 1e- (equal (cadr v) p 1e-)) l1)
	(setq s2 (ssadd (caddr v) s2)
	      ;; RJP - added list collection
	      l	 (cons (caddr v) l)
	      l1 (vl-list* (car v) (cadr v) l1)
	      fl t
	)
	(setq l2 (cons v l2))
      )
    )
    fl
  )
   (setq vl l2
	 l2 nil
	 fl nil
   )
)
     )
   )
   (princ "\nNo valid objects found.")
 )
 (sssetfirst nil s2)
 (setq n 0)
 ;; RJP - added numeric text on mid segments
 (foreach x (reverse l)
   (if	(setq p	(vlax-curve-getpointatdist
	  x
	  (/ (vlax-curve-getdistatparam x (vlax-curve-getendparam x)) 2.)
	)
)
     (entmakex	(list '(0 . "TEXT")
	      '(100 . "AcDbEntity")
	      '(67 . 0)
	      '(8 . "text")
	      '(100 . "AcDbText")
	      (cons 10 p)
	      '(40 . 250.0)
	      (cons 1 (itoa (setq n (1+ n))))
	      '(50 . 0.0)
	      '(41 . 1.0)
	      '(51 . 0.0)
	      '(71 . 0)
	      '(72 . 0)
	      '(11 0.0 0.0 0.0)
	      '(100 . "AcDbText")
	      '(73 . 0)
	)
     )
   )
 )
 (princ)
)
(vl-load-com)
(princ)

Have you seen Lee's chain select? Seems like you could use this to number your segments.

Yes I have seen it.

It is perfect for selection of all the tree.

But most important for me is the ascending numbering in order of air flow direction (or water flow) to accumulate the volume.

I need to know the air flow in each branch to be able calculate the size of duct.

Try this quick mod:

;;--------------------=={ Chain Selection }==-----------------;;
;;                                                            ;;
;;  Prompts the user to select an object and generates a      ;;
;;  selection chain of all objects sharing endpoints with     ;;
;;  objects in the accumulative selection.                    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;; RJP addtions below
(defun c:cs (/ en fl in l l1 l2 n s1 s2 sf vl)
 (setq	sf (list '(-4 . "<OR")
	 '(0 . "LINE,ARC")
	 '(-4 . "<AND")
	 '(0 . "LWPOLYLINE,SPLINE")
	 '(-4 . "<NOT")
	 '(-4 . "&=")
	 '(70 . 1)
	 '(-4 . "NOT>")
	 '(-4 . "AND>")
	 '(-4 . "<AND")
	 '(0 . "POLYLINE")
	 '(-4 . "<NOT")
	 '(-4 . "&")
	 '(70 . 89)
	 '(-4 . "NOT>")
	 '(-4 . "AND>")
	 '(-4 . "<AND")
	 '(0 . "ELLIPSE")
	 '(-4 . "<OR")
	 '(-4 . "<>")
	 '(41 . 0.0)
	 '(-4 . "<>")
	 (cons 42 (+ pi pi))
	 '(-4 . "OR>")
	 '(-4 . "AND>")
	 '(-4 . "OR>")
	 (if (= 1 (getvar 'cvport))
	   (cons 410 (getvar 'ctab))
	   '(410 . "Model")
	 )
   )
 )
 (if (setq s1 (ssget "_X" sf))
   (if	(setq en (ssget "_+.:E:S" sf))
     (progn
(setq s2 (ssadd)
      en (ssname en 0)
      l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
)
(repeat	(setq in (sslength s1))
  (setq	en (ssname s1 (setq in (1- in)))
	vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
  )
)
(while
  (progn
    (foreach v vl
      (if (vl-some '(lambda (p) (or (equal (car v) p 1e- (equal (cadr v) p 1e-)) l1)
	(setq s2 (ssadd (caddr v) s2)
	      ;; RJP - added list collection
	      l	 (cons (caddr v) l)
	      l1 (vl-list* (car v) (cadr v) l1)
	      fl t
	)
	(setq l2 (cons v l2))
      )
    )
    fl
  )
   (setq vl l2
	 l2 nil
	 fl nil
   )
)
     )
   )
   (princ "\nNo valid objects found.")
 )
 (sssetfirst nil s2)
 (setq n 0)
 ;; RJP - added numeric text on mid segments
 (foreach x (reverse l)
   (if	(setq p	(vlax-curve-getpointatdist
	  x
	  (/ (vlax-curve-getdistatparam x (vlax-curve-getendparam x)) 2.)
	)
)
     (entmakex	(list '(0 . "TEXT")
	      '(100 . "AcDbEntity")
	      '(67 . 0)
	      '(8 . "text")
	      '(100 . "AcDbText")
	      (cons 10 p)
	      '(40 . 250.0)
	      (cons 1 (itoa (setq n (1+ n))))
	      '(50 . 0.0)
	      '(41 . 1.0)
	      '(51 . 0.0)
	      '(71 . 0)
	      '(72 . 0)
	      '(11 0.0 0.0 0.0)
	      '(100 . "AcDbText")
	      '(73 . 0)
	)
     )
   )
 )
 (princ)
)
(vl-load-com)
(princ)

Thank you, it is on the right way, but numbering must be in order of air flow direction.

The biggest number is for the last branch with biggest airflow.

Change (reverse l) to l and it should be closer.

Change (reverse l) to l and it should be closer.

Yes really closer.

If I select the last branch, can it be considered as my expected the biggest number in the code ?

Whatever branch you pick should be the largest number.

Test-1.dwg

Whatever branch you pick should be the largest number.

In my test not.

Try to have a look in attachment.

Let me rephrase that .. If it's an end segment it should be the largest number.

Let me rephrase that .. If it's an end segment it should be the largest number.

Yes, it should be.

[ATTACH]64264[/ATTACH]

 

In my test not.

Try to have a look in attachment.

I see that my script works for polylines, but not for "2D polylines" (the short polylines in Test1.dwg, like 8, 10, 1, ...).

I will see that it does.

If you convert these 2D polylines to normal polylines my script works right now.

You better change the text height from 2.5 to 50 to see the result.

(Text mypoint 50 mystring)

Anyway, that text entities are not the final form

I see that my script works for polylines, but not for "2D polylines" (the short polylines in Test1.dwg, like 8, 10, 1, ...).

I will see that it does.

 

If you convert these 2D polylines to normal polylines my script works right now.

 

You better change the text height from 2.5 to 50 to see the result.

(Text mypoint 50 mystring)

Anyway, that text entities are not the final form

Yes, it works fine with normal polylines and in correct order as well.

Now I need to process secondary numbering (from branch - to branch) and then add it to attribute.

I fixed the 2D polyline problem. It's an old style of data; each point also stores a z-coordinate (completely useless, since polylines are flat, so you only need 1 z-coordinate) with a function that will not win a beauty prize.

I put the Text on a point along the polyline (I need such point anyway, to insert the block)

I tested it on your Test1.dwg . It works fine, I think.

;; @file 
;;  - Detect a tree structure
;;  - Number the branches
;;  (- add stuff to attributes, not really included in this file)
;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order

;; settings
(setq textheight 50)
(setq zerodistance 0.000001)
         
(defun Text (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))
                 


;;; 2d-coord->pt-lst
;; Converts a 2d coordinates flat list into a 2d point list
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0))
(defun 2d-coord->pt-lst (lst)
 (if lst
   (cons 
     (list (car lst) (cadr lst))
     (2d-coord->pt-lst (cddr lst))
   )
 )
)

;; no doubt this can be written more elegantly.
;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored
(defun 3d-coord->pt-lst (lst / i result)
 (setq 
   i 0
   result (list)
 )
 (repeat (fix (/ (length lst) 3 ))
   (setq result (append result (list (list (nth (* 3 i) lst) (nth (+ 1 (* 3 i)) lst)) )))
   (setq i (+ i 1))
 )
 result
)


(defun getLast (mylist)
 (nth (- (length mylist) 1) mylist)
)

(setq indexHandled (list))
(defun BTS (ss pt0 / i pts d1 d2 mypoint mystring lst)
 (setq i 0)
 (repeat (sslength ss)
     (setq pl (vlax-ename->vla-object (ssname ss i)))

     ;; get its vertices list
     (setq lst (vlax-get pl 'coordinates))

     (if (= "AcDb2dPolyline" (vla-get-ObjectName pl))
       (setq pts (3d-coord->pt-lst lst))
       (setq pts (2d-coord->pt-lst lst))
     )

     (setq d1 (distance (setq mypoint (nth 0 pts)) pt0) )
     (setq d2 (distance (setq mypoint (getLast pts)) pt0) )
     
     ;; counting ascending
     ;;(setq mystring (rtos (length indexHandled) 2 0))
     ;; counting descending
     (setq mystring (rtos (- (sslength ss) (length indexHandled)) 2 0))
   
   (if (not (member i indexHandled)) (progn
     (if (< d1 zerodistance) (progn
       (setq indexHandled (append indexHandled (list i)))
       
       ;; the Text is put on a point on the polyline.  Somewhere in the middle, but not exactly
       (Text (vlax-curve-getPointAtDist pl (/ d2 2)) textheight mystring)
       
       (bts ss (getLast pts))
     ))
     (if (< d2 zerodistance) (progn
         (setq indexHandled (append indexHandled (list i)))
       ;;(Text mypoint textheight mystring)
       (Text (vlax-curve-getPointAtDist pl (/ d1 2)) textheight mystring)
       (bts ss (nth 0 pts))
     ))
   ))
   (setq i (+ i 1 ))
 )
)

(defun c:BTS ( / ss index trunk pt0)
 (setq indexHandled (list))  ;; reset which branches have been handled yet
 (setq ss (ssget ":L" '((0 . "LWPOLYLINE,POLYLINE"))))
 (setq pt0 (osnap (getpoint "\nSelect the trunk <osnap on the base of the trunk>: ") "_end"))
 (BTS ss pt0)
 (princ)
)

I fixed the 2D polyline problem. It's an old style of data; each point also stores a z-coordinate (completely useless, since polylines are flat, so you only need 1 z-coordinate) with a function that will not win a beauty prize.

 

I put the Text on a point along the polyline (I need such point anyway, to insert the block)

 

I tested it on your Test1.dwg . It works fine, I think.

 

;; @file 
;;  - Detect a tree structure
;;  - Number the branches
;;  (- add stuff to attributes, not really included in this file)
;; @see http://www.cadtutor.net/forum/showthread.php?104740-Automatic-numbering-in-air-flow-order

;; settings
(setq textheight 50)
(setq zerodistance 0.000001)
         
(defun Text (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))
                 


;;; 2d-coord->pt-lst
;; Converts a 2d coordinates flat list into a 2d point list
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0))
(defun 2d-coord->pt-lst (lst)
 (if lst
   (cons 
     (list (car lst) (cadr lst))
     (2d-coord->pt-lst (cddr lst))
   )
 )
)

;; no doubt this can be written more elegantly.
;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored
(defun 3d-coord->pt-lst (lst / i result)
 (setq 
   i 0
   result (list)
 )
 (repeat (fix (/ (length lst) 3 ))
   (setq result (append result (list (list (nth (* 3 i) lst) (nth (+ 1 (* 3 i)) lst)) )))
   (setq i (+ i 1))
 )
 result
)


(defun getLast (mylist)
 (nth (- (length mylist) 1) mylist)
)

(setq indexHandled (list))
(defun BTS (ss pt0 / i pts d1 d2 mypoint mystring lst)
 (setq i 0)
 (repeat (sslength ss)
     (setq pl (vlax-ename->vla-object (ssname ss i)))

     ;; get its vertices list
     (setq lst (vlax-get pl 'coordinates))

     (if (= "AcDb2dPolyline" (vla-get-ObjectName pl))
       (setq pts (3d-coord->pt-lst lst))
       (setq pts (2d-coord->pt-lst lst))
     )

     (setq d1 (distance (setq mypoint (nth 0 pts)) pt0) )
     (setq d2 (distance (setq mypoint (getLast pts)) pt0) )
     
     ;; counting ascending
     ;;(setq mystring (rtos (length indexHandled) 2 0))
     ;; counting descending
     (setq mystring (rtos (- (sslength ss) (length indexHandled)) 2 0))
   
   (if (not (member i indexHandled)) (progn
     (if (< d1 zerodistance) (progn
       (setq indexHandled (append indexHandled (list i)))
       
       ;; the Text is put on a point on the polyline.  Somewhere in the middle, but not exactly
       (Text (vlax-curve-getPointAtDist pl (/ d2 2)) textheight mystring)
       
       (bts ss (getLast pts))
     ))
     (if (< d2 zerodistance) (progn
         (setq indexHandled (append indexHandled (list i)))
       ;;(Text mypoint textheight mystring)
       (Text (vlax-curve-getPointAtDist pl (/ d1 2)) textheight mystring)
       (bts ss (nth 0 pts))
     ))
   ))
   (setq i (+ i 1 ))
 )
)

(defun c:BTS ( / ss index trunk pt0)
 (setq indexHandled (list))  ;; reset which branches have been handled yet
 (setq ss (ssget ":L" '((0 . "LWPOLYLINE,POLYLINE"))))
 (setq pt0 (osnap (getpoint "\nSelect the trunk <osnap on the base of the trunk>: ") "_end"))
 (BTS ss pt0)
 (princ)
)

Food for thought

;;This
(defun getlast (mylist) (nth (- (length mylist) 1) mylist))
;; Could be
(defun getlast (mylist) (car (reverse mylist)))
;; no doubt this can be written more elegantly.
;; this does what 2d-coord->pt-lst does, except every third coordinate is ignored
(defun 3d-coord->pt-lst (lst / i r)
 (setq	i 0
r (list)
 )
 (repeat (fix (/ (length lst) 3))
   (setq r (append r (list (list (nth (* 3 i) lst) (nth (+ 1 (* 3 i)) lst)))))
   (setq i (+ i 1))
 )
 r
)
;; Here's another way to do it 
(defun 3d-coord->pt-lstrjp (lst / r)
 (while lst (setq r (cons (list (car lst) (cadr lst)) r)) (setq lst (cdddr lst)))
 (reverse r)
)
;; Mod to the recursive one
(defun 3d-coord->to2dpt-lst (lst)
 (if lst
   (cons (list (car lst) (cadr lst)) (3d-coord->to2dpt-lst (cdd[b]d[/b]r lst)))
 )
)

Quick benchmark on a list of ~1000 numbers:

972 Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):

 

(3D-COORD->TO2DPT-LST L)......1375 / 9.25

(3D-COORD->PT-LSTRJP L).......1687 / 7.54

(3D-COORD->PT-LST L).........12718 / 1.00

_$