The following will number the vertices of your pipe network,
and then create an csv file of it.
If you open it in Excel, there will be a blank column for you to enter pipe diameters.
- (defun c:test () (setq fuzz 0.1) (prompt "\nSelect Network : ") (setq s (ssget '((0 . "LINE")))) ; Build Point list (setq pl nil) (repeat (setq i (sslength s)) (setq ent (entget (ssname s (setq i (1- i)))) p1 (cdr (assoc 10 ent)) pl (if (not (positionfuzz p1 pl)) (cons p1 pl) pl) p2 (cdr (assoc 11 ent)) pl (if (not (positionfuzz p2 pl)) (cons p2 pl) pl) ) ) ; Draw Vertex Number (foreach p pl (mk_mtext p (itoa (vl-position p pl)) 5 0.5 0) ) ; Build the Edge List (setq el nil) (repeat (setq i (sslength s)) (setq ent (entget (ssname s (setq i (1- i)))) p1 (cdr (assoc 10 ent)) el (cons (positionfuzz p1 pl) el) p2 (cdr (assoc 11 ent)) el (cons (positionfuzz p2 pl) el) ) ) ;(setq pl (vl-sort pl (function (lambda (a b) (< (caddr a) (caddr b))))) ;; Sort on Z Coordinate ; pl (vl-sort pl (function (lambda (a b) (< (cadr a) (cadr b))))) ;; Sort on Y Coordinate ; pl (vl-sort pl (function (lambda (a b) (< (car a) (car b))))) ;; Sort on X Coordinate (setq xl nil) (print el) (while el (setq pol (list (cadr el)(car el)) ; We go reverse as we will cons the polyline nxt (car pol) ; nxt will be our next edge el (cddr el) ; Remove first two edges from el ) (if (not (positionfuzz nxt el)) ;The previous edge was an end of line (setq pol (reverse pol) ;We reverse our Polyline nxt (car pol) ;and adjust our next edge ) ) (while (setq n (positionfuzz nxt el)) (setq el (removenth n el) n (- n (rem n 2)) pol (cons (nth n el) pol) el (removenth n el) nxt (car pol) ) (if (not (positionfuzz nxt el)) (setq pol (reverse pol) nxt (car pol) ) ) ) (setq xl (cons pol xl)) ) (setq xl (reverse xl)) ; New Create the file (setq f (open "C:\\PIPENET.CSV" "a")) (write-line "From, To,Diam.,Len/Dir" f) (foreach pol xl (setq fr (car pol) p1 (nth fr pl) pol (cdr pol) ) (repeat (length pol) (setq to (car pol) p2 (nth to pl) l (distance p1 p2) v (mapcar '- p2 p1) a (cond ((> (car v) fuzz) "E") ((< (car v) (- fuzz)) "W") ((> (cadr v) fuzz) "N") ((< (cadr v) (- fuzz)) "S") ((> (caddr v) fuzz) "U") ((< (caddr v) (- fuzz)) "D") ) ) (setq lin (strcat (itoa fr) "," (itoa to) ", ," a (rtos l 2 1))) (princ (strcat "\n" lin)) (write-line lin f) (setq fr to p1 p2 pol (cdr pol) ) ) ) (close f) (princ)) ;;****************************************************************************;;; mk_mtext ;;; Arguments: p, Insertion Point. ;;; s, Text. ;;; j, Justification: ;;; 1 = Top left; 2 = Top center; 3 = Top right; ;;; 4 = Middle left; 5 = Middle center; 6 = Middle right; ;;; 7 = Bottom left; 8 = Bottom center; 9 = Bottom right ;;; h, Text Height. ;;; r, Rotation. ;;;****************************************************************************;(defun mk_mtext (p s j h r) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 p) (cons 71 j) (cons 40 h) (cons 50 r) (cons 1 s) ) ));;----------------------=={ Remove Nth }==--------------------;;;; ;;;; Removes the item at the nth index in a supplied list ;;;;------------------------------------------------------------;;;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;;;------------------------------------------------------------;;;; Arguments: ;;;; n - index of item to remove (zero based) ;;;; l - list from which item is to be removed ;;;;------------------------------------------------------------;;;; Returns: List with item at index n removed ;;;;------------------------------------------------------------;;(defun RemoveNth ( n l / i ) (setq i -1) (vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l)); positionfuzz by irneb ;(defun positionfuzz (item sequence / p) (setq p -1) (if (vl-some (function (lambda (a) (setq p (1+ p)) (equal item a fuzz))) sequence) p))
Ugly code, but seems to work!
ymg
pipenet.dwg
PIPENET.CSV
Pipenet.LSP | 
