Lisp to place pipe dia

Lisp to place pipe dia

tanvirme2k9
Contributor Contributor
4,455 Views
34 Replies
Message 1 of 35

Lisp to place pipe dia

tanvirme2k9
Contributor
Contributor

Hi all,

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.

4,456 Views
34 Replies
Replies (34)
Message 2 of 35

ВeekeeCZ
Consultant
Consultant

Hi tanvirme, welcome to this forums.

 

Try this code.

 

Spoiler
(vl-load-com)

(defun C:PipeDia (/ *error* _SortPtListByDist oCMDECHO oOSMODE doc ss ensel en i pt1 pt2 ptm pts pt1dist pt2dist  txt)

;------
 (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CMDECHO oCMDECHO)
    (setvar 'OSMODE oOSMODE)
    (vla-endundomark doc)
    (princ))

;------
 (defun _SortPtListByDist  (ptList en)
  ;; Argument: Point list
  ;; Returns: Point list, sorted by distance from curve
  ;; By BlackBox
  ;; http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
  (mapcar
    '(lambda (x / ptList2)
       (setq ptList2 (append (cdr x) ptList2)))
    (vl-sort
      (mapcar
        '(lambda (x / pt ptlist2)
           (setq ptlist2
                  (append
                    (cons
                      (vlax-curve-getDistAtPoint
			(ssname sspl 0)
			(vlax-curve-getClosestPointTo en x T))                        
                      x)
                    ptlist2)))
        ptList)
      '(lambda (x y)
         (< (car x) (car y))))))
    
  
;------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq oCMDECHO (getvar 'CMDECHO)
  	oOSMODE	 (getvar 'OSMODE))
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)
  
  (if (and (princ "\nNeed BLOCKs, ")
	   (setq ss (ssget '((0 . "INSERT"))))
	   (< 2 (setq i (sslength ss)))
	   (setq ensel (entsel "\nSelect a (poly)line closer to beginning: "))
	   (wcmatch (cdr (assoc 0 (entget (setq en (car ensel))))) "LWPOLYLINE,LINE")
	   (if (> (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (cadr ensel)))
		  (/ (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) 2))
	     (progn								
	       (command "_.REVERSE" en "")
	       (princ "\nPolyline was reversed.")
	       (setq en (entlast)))						
	     T)
	   (while (not (minusp (setq i (1- i))))
	     (setq pts (cons (vlax-curve-getClosestPointTo en (cdr (assoc 10 (entget (ssname ss i))))) pts)))
	   (setq pts (_SortPtListByDist pts en))
	   (setq i 0))
    (repeat (1- (length pts))
      (setq pt1 (nth i pts)
	    pt1dist (vlax-curve-getDistAtPoint en pt1)
	    pt2 (nth (1+ i) pts)
	    pt2dist (vlax-curve-getDistAtPoint en pt2)
	    ptm (vlax-curve-getPointAtDist en (+ pt1dist (/ (- pt2dist pt1dist) 2))))
      (cond ((< i 2) (setq txt "%%c1\""))
	    ((< i 3) (setq txt "%%c1.25\""))
	    ((< i 5) (setq txt "%%c1.5\""))
	    ((< i 10) (setq txt "%%c2\""))
	    (T (setq txt "%%c")))
      (command "_.TEXT" ptm 1 "" txt) 						;<- Here change a text hight
      (setq i (1+ i)))
    (princ "\nWrong selection, need BLOCKs."))

  (setvar 'OSMODE oOSMODE)
  (setvar 'CMDECHO oCMDECHO)
  (vla-endundomark doc)
  (princ)
)

The code presupposes that you have a single line or polyline (you need to join them). If you have it in reverse, program reverse it automatically.

 

BTW. Your drawing doesn't meet the conditions you gave (second 1.25 should be 1.5).

 

Question to some college who uses an imperial units: What is a correct format of this number  (command "_.TEXT" 1'-3"1 "" txt). Thanks in advance.

0 Likes
Message 3 of 35

tanvirme2k9
Contributor
Contributor

Oops! sorry, right the second 1.25" will be 1.5". I have found this error executing the command -

 

Object direction has been reversed.
Polyline was reversed.
Error: bad argument value: AcDbCurve 43

 

and sometimes -

 

Error: bad argument type: lselsetp nil

0 Likes
Message 4 of 35

ВeekeeCZ
Consultant
Consultant

Try this...

 

Spoiler
(vl-load-com)

(defun C:PipeDia (/ *error* _SortPtListByDist oCMDECHO oOSMODE doc ss ensel en i pt1 pt2 ptm pts pt1dist pt2dist  txt)

;------
 (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CMDECHO oCMDECHO)
    (setvar 'OSMODE oOSMODE)
    (vla-endundomark doc)
    (princ))

;------
 (defun _SortPtListByDist  (ptList en)
  ;; Argument: Point list
  ;; Returns: Point list, sorted by distance from curve
  ;; By BlackBox
  ;; http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
  (mapcar
    '(lambda (x / ptList2)
       (setq ptList2 (append (cdr x) ptList2)))
    (vl-sort
      (mapcar
        '(lambda (x / pt ptlist2)
           (setq ptlist2
                  (append
                    (cons
                      (vlax-curve-getDistAtPoint
			(ssname sspl 0)
			(vlax-curve-getClosestPointTo en x T))                        
                      x)
                    ptlist2)))
        ptList)
      '(lambda (x y)
         (< (car x) (car y))))))
    
  
;------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq oCMDECHO (getvar 'CMDECHO)
  	oOSMODE	 (getvar 'OSMODE))
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)
  
  (if (and (princ "\nNeed BLOCKs, ")
	   (setq ss (ssget '((0 . "INSERT"))))
	   (< 2 (setq i (sslength ss)))
	   (setq ensel (entsel "\nSelect a (poly)line closer to beginning: "))
	   (wcmatch (cdr (assoc 0 (entget (setq en (car ensel))))) "LWPOLYLINE,LINE")
	   (if (> (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (cadr ensel)))
		  (/ (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) 2))
	     (progn								
	       (command "_.REVERSE" en "")
	       (princ "\nPolyline was reversed."))						
	     T)
	   (while (not (minusp (setq i (1- i))))
	     (setq pts (cons (vlax-curve-getClosestPointTo en (cdr (assoc 10 (entget (ssname ss i))))) pts)))
	   (setq pts (_SortPtListByDist pts en))
	   (setq i 0))
    (repeat (1- (length pts))
      (setq pt1 (nth i pts)
	    pt1dist (vlax-curve-getDistAtPoint en pt1)
	    pt2 (nth (1+ i) pts)
	    pt2dist (vlax-curve-getDistAtPoint en pt2)
	    ptm (vlax-curve-getPointAtDist en (+ pt1dist (/ (- pt2dist pt1dist) 2))))
      (cond ((< i 2) (setq txt "%%c1\""))
	    ((< i 3) (setq txt "%%c1.25\""))
	    ((< i 5) (setq txt "%%c1.5\""))
	    ((< i 10) (setq txt "%%c2\""))
	    (T (setq txt "%%c")))
      (command "_.TEXT" ptm "1\'3\"" "" txt) 	;<- Here change a text hight
      (setq i (1+ i)))
    (princ "\nWrong selection, need BLOCKs."))

  (setvar 'OSMODE oOSMODE)
  (setvar 'CMDECHO oCMDECHO)
  (vla-endundomark doc)
  (princ)
)
0 Likes
Message 5 of 35

tanvirme2k9
Contributor
Contributor

Same

 

Error: bad argument type: lselsetp nil

0 Likes
Message 6 of 35

ВeekeeCZ
Consultant
Consultant

You know, since I don't get such an error it's hard to tell... 

 

Try again...

 

Spoiler
(vl-load-com)

(defun C:PipeDia (/ *error* _SortPtListByDist oCMDECHO oOSMODE doc ss ensel en i pt1 pt2 ptm pts pt1dist pt2dist  txt)

;------
 (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CMDECHO oCMDECHO)
    (setvar 'OSMODE oOSMODE)
    (vla-endundomark doc)
    (princ))

;------
 (defun _SortPtListByDist  (ptList en)
  ;; Argument: Point list
  ;; Returns: Point list, sorted by distance from curve
  ;; By BlackBox
  ;; http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
  (mapcar
    '(lambda (x / ptList2)
       (setq ptList2 (append (cdr x) ptList2)))
    (vl-sort
      (mapcar
        '(lambda (x / pt ptlist2)
           (setq ptlist2
                  (append
                    (cons
                      (vlax-curve-getDistAtPoint
			(ssname sspl 0)
			(vlax-curve-getClosestPointTo en x T))                        
                      x)
                    ptlist2)))
        ptList)
      '(lambda (x y)
         (< (car x) (car y))))))
    
  
;------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq oCMDECHO (getvar 'CMDECHO)
  	oOSMODE	 (getvar 'OSMODE))
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)
  
  (if (and (princ "\nNeed BLOCKs, ")
	   (setq ss (ssget '((0 . "INSERT"))))
	   (< 2 (setq i (sslength ss)))
	   (setq ensel (entsel "\nSelect a (poly)line closer to beginning: "))
	   (wcmatch (cdr (assoc 0 (entget (setq en (car ensel))))) "LWPOLYLINE,LINE")
	   (if (> (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (cadr ensel) T))
		  (/ (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) 2))
	     (progn								
	       (command "_.REVERSE" en "")
	       (princ "\nPolyline was reversed."))						
	     T)
	   (while (not (minusp (setq i (1- i))))
	     (setq pts (cons (vlax-curve-getClosestPointTo en (cdr (assoc 10 (entget (ssname ss i)))) T) pts)))
	   (setq pts (_SortPtListByDist pts en))
	   (setq i 0))
    (repeat (1- (length pts))
      (setq pt1 (nth i pts)
	    pt1dist (vlax-curve-getDistAtPoint en pt1)
	    pt2 (nth (1+ i) pts)
	    pt2dist (vlax-curve-getDistAtPoint en pt2)
	    ptm (vlax-curve-getPointAtDist en (+ pt1dist (/ (- pt2dist pt1dist) 2))))
      (cond ((< i 2) (setq txt "%%c1\""))
	    ((< i 3) (setq txt "%%c1.25\""))
	    ((< i 5) (setq txt "%%c1.5\""))
	    ((< i 10) (setq txt "%%c2\""))
	    (T (setq txt "%%c")))
      (command "_.TEXT" ptm "1\'3\"" "" txt)
      (setq i (1+ i)))
    (princ "\nWrong selection, need BLOCKs."))

  (setvar 'OSMODE oOSMODE)
  (setvar 'CMDECHO oCMDECHO)
  (vla-endundomark doc)
  (princ)
)

If the error persist, post the dwg and try find what line is causing that.

 

Use VLIDE command in autocad, in editor open youre pipedia.lsp. Then in Menu Debug / mark Break on Error. Then load pipedia with Ctrl+Alt+E. Then activate Autocad with Window/Activate Autocad and then run command PIPEDIA. If you get an error, find a line with Ctrl+F9 in Editor.

0 Likes
Message 7 of 35

tanvirme2k9
Contributor
Contributor

Thanks for reply. I followed the procedure and it stops at the following line.

 

(ssname sspl 0)

0 Likes
Message 8 of 35

ВeekeeCZ
Consultant
Consultant
Accepted solution

I see, it should be en.

 

Spoiler
(vl-load-com)

(defun C:PipeDia (/ *error* _SortPtListByDist oCMDECHO oOSMODE doc ss ensel en i pt1 pt2 ptm pts pt1dist pt2dist  txt)

;------
 (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CMDECHO oCMDECHO)
    (setvar 'OSMODE oOSMODE)
    (vla-endundomark doc)
    (princ))

;------
 (defun _SortPtListByDist  (ptList en)
  ;; Argument: Point list
  ;; Returns: Point list, sorted by distance from curve
  ;; By BlackBox
  ;; http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
  (mapcar
    '(lambda (x / ptList2)
       (setq ptList2 (append (cdr x) ptList2)))
    (vl-sort
      (mapcar
        '(lambda (x / pt ptlist2)
           (setq ptlist2
                  (append
                    (cons
                      (vlax-curve-getDistAtPoint
			en
			(vlax-curve-getClosestPointTo en x T))                        
                      x)
                    ptlist2)))
        ptList)
      '(lambda (x y)
         (< (car x) (car y))))))
    
  
;------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq oCMDECHO (getvar 'CMDECHO)
  	oOSMODE	 (getvar 'OSMODE))
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)
  
  (if (and (princ "\nNeed BLOCKs, ")
	   (setq ss (ssget '((0 . "INSERT"))))
	   (< 2 (setq i (sslength ss)))
	   (setq ensel (entsel "\nSelect a (poly)line closer to beginning: "))
	   (wcmatch (cdr (assoc 0 (entget (setq en (car ensel))))) "LWPOLYLINE,LINE")
	   (if (> (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (cadr ensel) T))
		  (/ (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) 2))
	     (progn								
	       (command "_.REVERSE" en "")
	       (princ "\nPolyline was reversed."))						
	     T)
	   (while (not (minusp (setq i (1- i))))
	     (setq pts (cons (vlax-curve-getClosestPointTo en (cdr (assoc 10 (entget (ssname ss i)))) T) pts)))
	   (setq pts (_SortPtListByDist pts en))
	   (setq i 0))
    (repeat (1- (length pts))
      (setq pt1 (nth i pts)
	    pt1dist (vlax-curve-getDistAtPoint en pt1)
	    pt2 (nth (1+ i) pts)
	    pt2dist (vlax-curve-getDistAtPoint en pt2)
	    ptm (vlax-curve-getPointAtDist en (+ pt1dist (/ (- pt2dist pt1dist) 2))))
      (cond ((< i 2) (setq txt "%%c1\""))
	    ((< i 3) (setq txt "%%c1.25\""))
	    ((< i 5) (setq txt "%%c1.5\""))
	    ((< i 10) (setq txt "%%c2\""))
	    (T (setq txt "%%c")))
      (command "_.TEXT" ptm "1\'3\"" "" txt)
      (setq i (1+ i)))
    (princ "\nWrong selection, need BLOCKs."))

  (setvar 'OSMODE oOSMODE)
  (setvar 'CMDECHO oCMDECHO)
  (vla-endundomark doc)
  (princ)
)
Message 9 of 35

tanvirme2k9
Contributor
Contributor

Great! worked like a magic. Loving the community! It will save a lot of time, thank you so much. I am wondering if it is possible to do the same thing for the entire piping system (I am new, so I didn't post it first as I don't know whether it is possible) with 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”

5< No. of blocks <=10           2”

10< No. of blocks <=20         2.25”

20< No. of blocks <=40         3”

40< No. of blocks <=100       4”

100< No. of blocks <=275     6”

 and also dimensioning it. I appolize that it may be an inappropriate question. Again Thank you very much..

0 Likes
Message 10 of 35

ВeekeeCZ
Consultant
Consultant

It's no problem... expending a range.

 

Spoiler
(vl-load-com)

(defun C:PipeDia (/ *error* _SortPtListByDist oCMDECHO oOSMODE doc ss ensel en i pt1 pt2 ptm pts pt1dist pt2dist  txt)

;------
 (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CMDECHO oCMDECHO)
    (setvar 'OSMODE oOSMODE)
    (vla-endundomark doc)
    (princ))

;------
 (defun _SortPtListByDist  (ptList en)
  ;; Argument: Point list
  ;; Returns: Point list, sorted by distance from curve
  ;; By BlackBox
  ;; http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
  (mapcar
    '(lambda (x / ptList2)
       (setq ptList2 (append (cdr x) ptList2)))
    (vl-sort
      (mapcar
        '(lambda (x / pt ptlist2)
           (setq ptlist2
                  (append
                    (cons
                      (vlax-curve-getDistAtPoint
			en
			(vlax-curve-getClosestPointTo en x T))                        
                      x)
                    ptlist2)))
        ptList)
      '(lambda (x y)
         (< (car x) (car y))))))
    
  
;------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq oCMDECHO (getvar 'CMDECHO)
  	oOSMODE	 (getvar 'OSMODE))
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)
  
  (if (and (princ "\nNeed BLOCKs, ")
	   (setq ss (ssget '((0 . "INSERT"))))
	   (< 2 (setq i (sslength ss)))
	   (setq ensel (entsel "\nSelect a (poly)line closer to beginning: "))
	   (wcmatch (cdr (assoc 0 (entget (setq en (car ensel))))) "LWPOLYLINE,LINE")
	   (if (> (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (cadr ensel) T))
		  (/ (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)) 2))
	     (progn								
	       (command "_.REVERSE" en "")
	       (princ "\nPolyline was reversed."))						
	     T)
	   (while (not (minusp (setq i (1- i))))
	     (setq pts (cons (vlax-curve-getClosestPointTo en (cdr (assoc 10 (entget (ssname ss i)))) T) pts)))
	   (setq pts (_SortPtListByDist pts en))
	   (setq i 0))
    (repeat (1- (length pts))
      (setq pt1 (nth i pts)
	    pt1dist (vlax-curve-getDistAtPoint en pt1)
	    pt2 (nth (1+ i) pts)
	    pt2dist (vlax-curve-getDistAtPoint en pt2)
	    ptm (vlax-curve-getPointAtDist en (+ pt1dist (/ (- pt2dist pt1dist) 2))))
      (cond ((< i 2) (setq txt "%%c1\""))
	    ((< i 3) (setq txt "%%c1.25\""))
	    ((< i 5) (setq txt "%%c1.5\""))
	    ((< i 10) (setq txt "%%c2\""))
	    ((< i 20) (setq txt "%%c2.25\""))
	    ((< i 40) (setq txt "%%c3\""))
	    ((< i 100) (setq txt "%%c4\""))
	    ((< i 275) (setq txt "%%c6\""))
	    (T (setq txt "%%c")))
      (command "_.TEXT" ptm "1\'3\"" "" txt)
      (setq i (1+ i)))
    (princ "\nWrong selection, need BLOCKs."))

  (setvar 'OSMODE oOSMODE)
  (setvar 'CMDECHO oCMDECHO)
  (vla-endundomark doc)
  (princ)
)

Dimensioning I'll do next time. But it would be quite similar... I tried find some "block dimensioning" on web and I'm surprised I couldn't find some...

0 Likes
Message 11 of 35

tanvirme2k9
Contributor
Contributor
Actually I wanted to place all the diameter one at time, may be it's not possible.
0 Likes
Message 12 of 35

tanvirme2k9
Contributor
Contributor

I was working with the previous 'pipedia', I found that I need a little modification like the image. Can you please modify a bit? Thanks in advance.

PipeDia.JPG

0 Likes
Message 13 of 35

ВeekeeCZ
Consultant
Consultant
Accepted solution

Ok, see the code below. Also added a layer handling, now it is placing the texts into correct layer (blue Pipe Dia)

 

Spoiler
(vl-load-com)

(defun C:PipeDia (/ *error* _SortPtListByDist oCMDECHO oOSMODE oCLAYER doc
	            ss ensel en len i pt1 pt2 ptm pts pt1dist pt2dist txt)

;------
 (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'OSMODE oOSMODE)
    (setvar 'CLAYER oCLAYER)
    (setvar 'CMDECHO oCMDECHO)
    (vla-endundomark doc)
    (princ))

;By BlackBox, http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
 (defun _SortPtListByDist  (ptList en)
  (mapcar
    '(lambda (x / ptList2)
       (setq ptList2 (append (cdr x) ptList2)))
    (vl-sort
      (mapcar
        '(lambda (x / pt ptlist2)
           (setq ptlist2
                  (append
                    (cons
                      (vlax-curve-getDistAtPoint
			en
			(vlax-curve-getClosestPointTo en x T))                        
                      x)
                    ptlist2)))
        ptList)
      '(lambda (x y)
         (< (car x) (car y))))))
    
  
;------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq oCMDECHO (getvar 'CMDECHO)
  	oOSMODE	 (getvar 'OSMODE)
	oCLAYER	 (getvar 'CLAYER))
  (setvar 'CMDECHO 0)
  (setvar 'OSMODE 0)
  
  (if (and (princ "\nNeed BLOCKs, ")
	   (setq ss (ssget '((0 . "INSERT"))))
	   (< 1 (setq i (sslength ss)))
	   (setq ensel (entsel "\nSelect a (poly)line closer to beginning: "))
	   (wcmatch (cdr (assoc 0 (entget (setq en (car ensel))))) "LWPOLYLINE,LINE")
	   (if (> (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en (cadr ensel) T))
		  (/ (setq len (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en))) 2))
	     (progn								
	       (command "_.REVERSE" en "")
	       (princ "\nPolyline was reversed."))						
	     T)
	   (while (not (minusp (setq i (1- i))))
	     (setq pts (cons (vlax-curve-getClosestPointTo en (cdr (assoc 10 (entget (ssname ss i))))) pts)))
	   (setq pts (_SortPtListByDist pts en))
	   (if (> (- len (vlax-curve-getDistAtPoint en (last pts))) 10)
	     (setq pts (append pts (list (vlax-curve-getEndPoint en))))
	     T)
	   (not (command "_.-LAYER" "_M" "Pipe Dia" "_C" 170 "" ""))
	   (setq i 0)
	   )
    (repeat (1- (length pts))
      (setq pt1 (nth i pts)
	    pt1dist (vlax-curve-getDistAtPoint en pt1)
	    pt2 (nth (1+ i) pts)
	    pt2dist (vlax-curve-getDistAtPoint en pt2)
	    ptm (vlax-curve-getPointAtDist en (+ pt1dist (/ (- pt2dist pt1dist) 2))))
      (cond ((< i 2) (setq txt "%%c1\""))
	    ((< i 3) (setq txt "%%c1.25\""))
	    ((< i 5) (setq txt "%%c1.5\""))
	    ((< i 10) (setq txt "%%c2\""))
	    ((< i 20) (setq txt "%%c2.25\""))
	    ((< i 40) (setq txt "%%c3\""))
	    ((< i 100) (setq txt "%%c4\""))
	    ((< i 275) (setq txt "%%c6\""))
	    (T (setq txt "%%c")))
      (command "_.TEXT" ptm "1\'3\"" "" txt)
      (setq i (1+ i)))
    (princ "\nWrong selection, need BLOCKs."))

  (setvar 'OSMODE oOSMODE)
  (setvar 'CLAYER oCLAYER)
  (setvar 'CMDECHO oCMDECHO)
  (vla-endundomark doc)
  (princ)
)
Message 14 of 35

tanvirme2k9
Contributor
Contributor

Great!! Thank you man!

0 Likes
Message 15 of 35

ВeekeeCZ
Consultant
Consultant
Accepted solution

@tanvirme2k9 wrote:

... I am wondering if it is possible to do the same thing for the entire piping system ... 


Yes, it can. Well, almost, with some restrictions and requirements - look at the attachment, adjusted dwg:


- Each tube has its single line or polyline in the right direction (your previous drawing contained one line for opposite tubes with opposite flow - is not possible). For a multiple break you can use one of the CABs routines - very nice.

http://www.theswamp.org/index.php?topic=10370.0

Spoiler
It requires to be registered, but it's worth it.

- Blocks are assigned the its curve based on distances (less than 10 inches). Blocks must be inserted with sufficient accuracy.
- The cross main pipe can not be labeled - you can include this (poly)line in a selection, but it has no blocks closer than 10 inches, would not labeled)
- Selection function is properly filtered  - when selecting a window can be applied to the entire system objects, other than blocks, lines and polylines will be excluded)
- When selected, you can check the direction of the curves (marked with points at beginnings), you cat manually select the one with wrong direction a reverse it.

- You cad try what can be done and what not - but it is not bulletproof 🙂

 

Spoiler
(vl-load-com)
(defun C:PipesDia (/ *error* _SortPtListByDist _plDirCheck _ssFilter oVAR doc
	             ss sspl ensel en p i ptm pts ptsa pt1dist pt2dist txt)

;------
 (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))

;By BlackBox, http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
 (defun _SortPtListByDist  (ptList en)
  (mapcar
    '(lambda (x / ptList2)
       (setq ptList2 (append (cdr x) ptList2)))
    (vl-sort (mapcar '(lambda (x / pt ptlist2)
			(setq ptlist2 (append (cons (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en x T))
						    x)
					      ptlist2)))
		     ptList)
	     '(lambda (x y)
		(< (car x) (car 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))))
      (if (< 50 (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
	(progn
	  (setq enl (entlast))
	  (command "_.POINT" (vlax-curve-getPointAtDist en 20))
	  (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)
    
  
;------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------

  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (foreach e '(CMDECHO OSMODE ORTHOMODE PDMODE CLAYER CECOLOR)
    (setq oVAR (cons (cons e (getvar e)) oVAR)))
  (setvar 'CMDECHO 0)
  (setvar 'ORTHOMODE 0)
  (setvar 'OSMODE 0)
  (setvar 'PDMODE 3)	  
  
  (if (and (princ "\nNeed Blocks and (Poly)lines, ")
	   (setq ss (ssget '((0 . "INSERT,LWPOLYLINE,LINE"))))
	   (setq sspl (ssget "_P" '((0 . "LWPOLYLINE,LINE"))))
	   (setq p (sslength sspl))
	   (> p 1)
	   (setq ss (_ssFilter ss 0 "INSERT"))
	   (setq i (sslength ss))
	   (> i 0)
	   (not (command "_.-LAYER" "_M" "0" ""))
	   (setvar 'CECOLOR "2")
	   (_plDirCheck sspl)
	   (setvar 'CECOLOR (cdr (assoc 'CECOLOR oVAR)))
	   (not (command "_.-LAYER" "_M" "Pipe Dia" "_C" 170 "" ""))
	   (while (not (minusp (setq i (1- i))))
	     (setq ptsa (cons (cdr (assoc 10 (entget (ssname ss i)))) ptsa)))
      )
    (while (not (minusp (setq p (1- p))))
      (setq en (ssname sspl p)
	    pts nil)
      (if (and (foreach e ptsa
		 (if (> 10 (distance e (setq pt (vlax-curve-getClosestPointTo en e))))
		   (setq pts (cons pt pts))
		   T))
	       (setq pts (_SortPtListByDist pts en))
	       (if (> (- (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en))
			 (vlax-curve-getDistAtPoint en (last pts)))
		      10)
		 (setq pts (append pts (list (vlax-curve-getEndPoint en))))
		 T)
	       (setq i 0)
	  )
	(repeat (1- (length pts))
	  (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)))
		txt (cond ((< i 2)   "%%c1\"")
			  ((< i 3)   "%%c1.25\"")
			  ((< i 5)   "%%c1.5\"")
			  ((< i 10)  "%%c2\"")
			  ((< i 20)  "%%c2.25\"")
			  ((< i 40)  "%%c3\"")
			  ((< i 100) "%%c4\"")
			  ((< i 275) "%%c6\"")
			  (T         "%%c"))
		i (1+ i))
	  (command "_.TEXT" ptm "1\'3\"" "" txt))))
    (princ "\nWrong selection, need at least 2 BLOCKs and 1 (POLY)LINE."))

  (foreach e oVAR (setvar (car e) (cdr e)))
  (vla-endundomark doc)
  (princ)
)

@tanvirme2k9 wrote:

... and also dimensioning it. ...


This task is for a separate routine. So make a new thread on this topic. This principle of making dims between blocks can be generally used... Maybe someone comes up with nice and simple solution. If not, i'll make it later.
Message 16 of 35

tanvirme2k9
Contributor
Contributor
I can't believe my eyes!! Thanks a lot.....
0 Likes
Message 17 of 35

ВeekeeCZ
Consultant
Consultant

@ВeekeeCZ wrote:


- The cross main pipe can not be labeled - you can include this (poly)line in a selection, but it has no blocks closer than 10 inches, would not labeled)


I figured this out on my way to work... It would be a separated routine... calculation would use the latest texts (dia labels) of each tube. So I need the formula to calculate diameters of main tube.

0 Likes
Message 18 of 35

tanvirme2k9
Contributor
Contributor

Thanks for your effort. It will be same as the previous one i.e

The number of blocks         Dia

<=2                                     1”

2< No. of blocks <=3           1.25”

3< No. of blocks <=5           1.5”

5< No. of blocks <=10         2”

 10< No. of blocks <=20       2.25”

20< No. of blocks <=40       3”

40< No. of blocks <=100     4”

100< No. of blocks <=275   6”

and the main pipe can be started from any side - left/right or up/down. Please find the attached drawing as reference.

0 Likes
Message 19 of 35

ВeekeeCZ
Consultant
Consultant

@tanvirme2k9 wrote:

Thanks for your effort. It will be same as the previous one i.e

The number of blocks         Dia

<=2                                     1”

2< No. of blocks <=3           1.25”

3< No. of blocks <=5           1.5”

5< No. of blocks <=10         2”

 10< No. of blocks <=20       2.25” <<<  Should this be 2.5?

20< No. of blocks <=40       3”

40< No. of blocks <=100     4”

100< No. of blocks <=275   6”

and the main pipe can be started from any side - left/right or up/down. Please find the attached drawing as reference.


 

0 Likes
Message 20 of 35

ВeekeeCZ
Consultant
Consultant

@ВeekeeCZ wrote:

@ВeekeeCZ wrote:


- The cross main pipe can not be labeled - you can include this (poly)line in a selection, but it has no blocks closer than 10 inches, would not labeled)


I figured this out on my way to work... 


 

I addeed this feature as well. And made some corrections....

 

- you can select your main pipe as well (as part of main selection).

- if only one polyline left (all others has blocks close or on..) - this one will be recognize as main pipe automatically. It there is none or more then one, you will be asked for selection

- in first part of routine where you can check and reverse direction... I made a little change - If is the line long enought (>50) is the mark point made at distance of 20, in other cases (< 50) is made in its beginning point (some lines has length of 0)

 

Spoiler
(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 '((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" "0" ""))
	   (setvar 'CECOLOR "2")
	   (_plDirCheck sspl)
	   (setvar 'CECOLOR (cdr (assoc 'CECOLOR oVAR)))
	   (not (command "_.-LAYER" "_M" "Pipe Dia" "_C" 170 "" ""))
	   (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-getEndParam 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 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 <exit>: "))		;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 "\nWrong selection, need at least 2 BLOCKs and 1 (POLY)LINE."))

  (foreach e oVAR (setvar (car e) (cdr e)))
  (vla-endundomark doc)
  (princ)
)
0 Likes