Message 1 of 6
Sprinkler network Pipe Sizing
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
hi all,
when using this lisp with this file there is sum problems:
1-it can't recognize the main pipe.
2-text height for pipe size is 15 but i work with 200.
3-text layer is the same for the pipe.
4-text is without leader with is just a line on another layer
note that:
*Text Layer "FIRE-TEXT-P"
*Branch layer "FIRE-PIPE-P"
*Main Layer "FIRE-Main-P"
(vl-load-com)
(defun C:PipesDia (/ *error* _SortPtListByDist _plDirCheck _ssFilter _getDia oVAR doc
ss sspl ssm ensel en p i l pts ptm ptsa ptsm ptsmr skip pt1dist pt2dist)
;------
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg)))
(if sspts (repeat (sslength sspts)
(entdel (ssname sspts 0))
(ssdel (ssname sspts 0) sspts)))
(foreach e oVAR (setvar (car e) (cdr e)))
(vla-endundomark doc)
(princ))
;Modified. Orig By BlackBox, http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
(defun _SortPtListByDist (ptList en lst)
(mapcar
(function (lambda (x / ptList2)
(if lst
(setq ptList2 (car (cons (cdar x) ptList2)))
(setq ptList2 (append (cdar x) ptList2)))))
(vl-sort (mapcar
(function (lambda (x / pt ptlist2)
(setq ptlist2 (cons (cons (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (if lst (car x) x) T))
x)
ptlist2))))
ptList)
(function (lambda (x y)
(< (caar x)
(caar y)))))))
;------
(defun _plDirCheck (ss / i en enl enr sspt)
(setq sspt (ssadd))
(repeat (setq i (sslength ss))
(setq en (ssname ss (setq i (1- i))))
(setq enl (entlast))
(command "_.POINT" (vlax-curve-getPointAtDist
en
(if (< 50 (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
20
0)))
(if (/= enl (entlast))
(ssadd (entlast) sspt)))
(initget "Quit")
(setq ensel (entsel "\nDirections of polylines are OK? No, select one to reverse [Quit] <OK>: "))
(cond ((eq ensel "Quit") ;Quit, leave with nil
(command "_.ERASE" sspt ""))
((not ensel) ;OK, leave with T
(command "_.ERASE" sspt "")
T)
((wcmatch (cdr (assoc 0 (entget (setq enr (car ensel))))) "LWPOLYLINE,LINE") ;Reverse, go again
(command "_.REVERSE" enr "")
(princ "\nPolyline was reversed.")
(command "_.ERASE" sspt "")
(setq sspt nil)
(_PLDirCheck ss))
(T ;Wrong selection go again
(command "_.ERASE" sspt "")
(setq sspt nil)
(_PLDirCheck ss))))
;------
(defun _ssFilter (ss code flt / ssn)
(setq ssn (ssadd)
i (sslength ss))
(while (not (minusp (setq i (1- i))))
(if (wcmatch (cdr (assoc code (entget (ssname ss i)))) flt)
(ssadd (ssname ss i) ssn)))
ssn)
;------
(defun _getDia (i / )
(cond ((<= i 2) "25 mm")
((<= i 3) "32 mm")
((<= i 5) "40 mm")
((<= i 10) "50 mm")
((<= i 20) "65 mm")
((<= i 40) "80 mm")
((<= i 100) "100 mm")
((<= i 275) "150 mm")
(T "%%c")))
;------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------
(vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
(foreach e '(CMDECHO OSMODE ORTHOMODE PDMODE CLAYER CECOLOR LUNITS)
(setq oVAR (cons (cons e (getvar e)) oVAR)))
(setvar 'CMDECHO 0)
(setvar 'ORTHOMODE 0)
(setvar 'OSMODE 0)
(setvar 'PDMODE 3)
(setvar 'LUNITS 4)
(if (and (princ "\nNeed Blocks and (Poly)lines, ")
(setq ss (ssget "_:L" '((0 . "INSERT,LWPOLYLINE,LINE"))))
(setq sspl (ssget "_P" '((0 . "LWPOLYLINE,LINE")))) ;filter origin ss for PL/Lines only
(setq p (sslength sspl))
(> p 0)
(setq ss (_ssFilter ss 0 "INSERT")) ;filter origin ss for Block only
(setq i (sslength ss))
(> i 1)
(not (command "_.-LAYER" "_M" "Pipe Dia" "_C" 170 "" ""))
(setvar 'CECOLOR "2")
(_plDirCheck sspl)
(setvar 'CECOLOR (cdr (assoc 'CECOLOR oVAR)))
(while (not (minusp (setq i (1- i))))
(setq ptsa (cons (cdr (assoc 10 (entget (ssname ss i)))) ptsa))) ;make a list of blocks ins points
(setq ssm (ssadd))
)
(progn
(while (not (minusp (setq p (1- p)))) ;for all polylines
(setq en (ssname sspl p)
pts nil)
(if (and (foreach e ptsa ;enclose blocks to its polylines (less 10)
(if (> 10 (distance e (setq pt (vlax-curve-getClosestPointTo en e))))
(setq pts (cons pt pts))
T))
(if pts
(setq pts (_SortPtListByDist pts en nil)) ;sort by dist
(progn
(ssadd en ssm) ;ss for main pipe
nil))
(setq ptsm (cons (cons (vlax-curve-getEndPoint en) (length pts)) ptsm)) ;make pairs of (pt end of pipe + numb. of blocks) for main pipe
(if (> (- (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) ;add last point of pipe without a block
(vlax-curve-getDistAtPoint en (last pts)))
10)
(setq pts (append pts (list (vlax-curve-getEndPoint en))))
T)
(setq i 0)
)
(repeat (1- (length pts)) ;mark diameters of all but main pipe.
(setq pt1dist (vlax-curve-getDistAtPoint en (nth i pts))
pt2dist (vlax-curve-getDistAtPoint en (nth (1+ i) pts))
ptm (vlax-curve-getPointAtDist en (+ pt1dist (/ (- pt2dist pt1dist) 2))) ;middle point
txt (_getDia (1+ i))
i (1+ i))
(command "_.TEXT" ptm "1\'3\"" "" txt))))
(if (and (cond ((= (sslength ssm) 1) ;if only pipe left, take it as MAIN PIPE
(setq en (ssname ssm 0)))
(T
(and (setq ensel (entsel "\nSelect the MAIN PIPE <quit>: ")) ;select new if more then 1 or none
(setq en (car ensel))
(wcmatch (cdr (assoc 0 (entget en))) "LWPOLYLINE,LINE"))))
(> (length ptsm) 1)
(setq ptsm (_SortPtListByDist ptsm en 0)) ;sort by dist
(setq i 0
skip 0)
(repeat (1- (length ptsm)) ;if pipes at across each other (less 5)
(if (< (- (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (car (nth (1+ i) ptsm))))
(vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (car (nth i ptsm)))))
5)
(setq skip (+ skip (cdr (nth i ptsm)))) ;count block of skipped pipes
(setq ptsmr (cons (cons (car (nth i ptsm)) ;created REVERED list!! (was already sorted)
(+ skip (cdr (nth i ptsm))))
ptsmr)
skip 0))
(setq i (1+ i)))
(if (> (- (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) ;add last part exceeding (more 10)
(vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (car (last ptsmr)))))
10)
(setq ptsmr (cons (cons (vlax-curve-getEndPoint en) 0) ptsmr))
T)
(setq i 0
l 0
ptsmr (reverse ptsmr)) ;list REVERSE back.
)
(repeat (1- (length ptsmr)) ;mark diameters of main pipe
(setq pt1dist (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (car (nth i ptsmr))))
pt2dist (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (car (nth (1+ i) ptsmr))))
ptm (vlax-curve-getPointAtDist en (+ pt1dist (/ (- pt2dist pt1dist) 2)))
l (+ l (cdr (nth i ptsmr)))
txt (_getDia l)
i (1+ i))
(command "_.TEXT" ptm "1\'3\"" "" txt))))
(princ "\nTerminated by user or by error: Wrong selection, need at least 2 BLOCKs and 1 (POLY)LINE."))
(foreach e oVAR (setvar (car e) (cdr e)))
(vla-endundomark doc)
(princ)
)
