I am interested in a lisp that will insert pipe diameter. The pipe is just a line or polyline. Blocks are placed on the pipe at different distances. The pipe dia will be placed in between two blocks with a dia symbol according to the following rule –
The number of block Dia
<=2 1”
2< No. of blocks <=3 1.25”
3< No. of blocks <=5 1.5”
5< No. of blocks <=10 2”
For better understand please see the attached file. Thanks in advance.
Dimensioning I'll do next time. ... I tried find some "block dimensioning" on web and I'm surprised I couldn't find some...
Hi, here it my last piece... This time I made two version... the first with handling of current layer and dimstyle, the second without. Both works same... if is blocks's X coordinate range 10 times different (larger or lesser) then Y coordinate range then is horizontal or vertical continued dimension made automatically, otherwise you can pick whether dim would be horizontal, vertical or aligned.
(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) "%%c1\"")
((<= i 3) "%%c1.25\"")
((<= i 5) "%%c1.5\"")
((<= i 10) "%%c2\"")
((<= i 20) "%%c2.5\"")
((<= i 40) "%%c3\"")
((<= i 100) "%%c4\"")
((<= i 275) "%%c6\"")
(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)
)
Now you need fix your drawing - fix your blocks... in the block editor explode the inner block, all objects put into layer 0. Just keep colors. Then before you're apply this routine isolate layers of blocks, pipes and main pipe (text layer is not necessary) first.
Dimensioning I'll do next time. ... I tried find some "block dimensioning" on web and I'm surprised I couldn't find some...
Hi, here it my last piece... This time I made two version... the first with handling of current layer and dimstyle, the second without. Both works same... if is blocks's X coordinate range 10 times different (larger or lesser) then Y coordinate range then is horizontal or vertical continued dimension made automatically, otherwise you can pick whether dim would be horizontal, vertical or aligned.
