LISP to count MTEXT & Polylines

November 12, 2016

Hi,

I have been using the LISP below which was put together with the kind help of people on this forum......

(defun C:checklabel ( / SSX txt )
(foreach x '(63 90 125 180 250 315)
 (if (setq SSX (ssget "_X" (list (cons 0 "MTEXT")(cons 1 (setq txt (strcat (itoa x) "mm PE")))(if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
  (princ (strcat "\nThere are " (itoa (sslength SSX)) " MTEXT objects with content \"" txt "\" on the current tab."))
  
 )
)
(princ)
)

I have a modification that I would love to add but I am struggling.

The current code counts MTEXT on a drawing with a particular value (63mm PE/90mm PE/125mm PE) etc.

Each MTEXT is offset from a Polyline (each MTEXT labels the size of each section of pipe). I was wondering if it is possible to list the total length of Polyline for each type of MTEXT by looking at the nearest Polyline to each MTEXT on the '0gas' layer.

Therefore when you run the command it would say something like:

(There are 48 MTEXT objects with content "63mm PE" on the current tab and the length is 110.5m).

(There are 20 MTEXT objects with content "90mm PE" on the current tab and the length is 90.2m)

This is way too advanced for me but could be a good challenge for someone!

Edited November 16, 2016 by andy_06
Code Tag Added

November 14, 2016

The current code counts MTEXT on a drawing with a particular value (63mm PE/90mm PE/125mm PE) etc.

Each MTEXT is offset from a Polyline (each MTEXT labels the size of each section of pipe). I was wondering if it is possible to list the total length of Polyline for each type of MTEXT by looking at the nearest Polyline to each MTEXT on the '0gas' layer....

Definitely doable.

Post a sample drawing and let us see what we're dealing here.

Do those numbers [ 63 mm ] represents the true length of the polyline? Then it will a lot easier.

pBe

November 14, 2016

Definitely doable.

Post a sample drawing and let us see what we're dealing here.

Do those numbers [ 63 mm ] represents the true length of the polyline? Then it will a lot easier.

pBe

I have attached a drawing, unfortunately the 63mm is referring to the diameter of the pipe (I need the routine to look at the length of each pipe).

On the drawing there is 14.1m of 90mm PE (1 x length of pipe) and 34.17m of 63mm PE (2 x lengths of pipe). Hopefully this makes sense!

Thanks!

Test.dwg

November 15, 2016

...On the drawing there is 14.1m of 90mm PE (1 x length of pipe) and 34.17m of 63mm PE (2 x lengths of pipe). Hopefully this makes sense!

...

There are 2 MTEXT objects with content "63mm PE" on the current tab and the length is 34.17m.

There are 1 MTEXT objects with content "90mm PE" on the current tab and the length is 14.18m.

So its total length of all "63mm PE" correct?

November 15, 2016

There are 2 MTEXT objects with content "63mm PE" on the current tab and the length is 34.17m.
There are 1 MTEXT objects with content "90mm PE" on the current tab and the length is 14.18m.

So its total length of all "63mm PE" correct?

Yes that is correct.

I need it to list the total length for each label type,

i.e.

(There are 2 MTEXT objects with content "63mm PE" on the current tab and the total length is 34.17m).

(There are 1 MTEXT objects with content "90mm PE" on the current tab and the length is 14.18m)

On each drawing that I do there is a network of pipes (polylines) which each have the MTEXT labels to show the diameter. So this will be a great way of me checking the total length of each pipe diameter (63mm/90mm/125mm/180mm)

November 15, 2016

(defun C:demo  (/ ss i pl_list mt_list mtpt_list sn a b c d e f g h tmp _nearest thelenght)
(setq _relist (lambda (m)
     ((if m vl-remove-if vl-remove-if-not) '(lambda (x)
			(equal (car f) (car x))) g)))
(if (setq ss (ssget 
	       '((410 . "Model")(8 . "0gas")
	         (-4 . "<OR")
               	 (-4 . "<AND")(0 . "MTEXT")(1 . "#*[Pp][Ee]")
		 (-4 . "AND>") (0 . "LWPOLYLINE") (-4 . "OR>")))
        )
(progn          
(repeat (setq i (sslength ss))
             (setq sn (ssname ss (setq i (1- i))))
                   
             	(if (eq (cdr (assoc 0 (setq ent (entget  sn)))) "LWPOLYLINE")
                   	(setq pl_list (cons (list (vlax-curve-getDistAtParam sn
                                                       (vlax-curve-getendparam sn)) sn ) pl_list))
                   	(setq mt_list (cons (list (cdr (assoc 10 ent)) (atoi (cdr (assoc 1 ent)))) mt_list))
                   )
                   )	
(while (and (setq a (car mt_list)) pl_list)
                 (setq tmp (mapcar '(lambda (c)
			(list c (distance (car a)
                                              (vlax-curve-getClosestPointTo (cadr c) (car a)))
                                     	(car c) (cadr a)))  pl_list))
             		(setq _nearest (car (vl-sort tmp '(lambda ( d e )
                                                           (< (cadr d) (cadr e)))))
                             
                             pl_list (vl-remove (Car _nearest) pl_list)
                             mtpt_list (cons (list   (cadddr _nearest) (caddr _nearest)) mtpt_list)
                             mt_list (cdr mt_list))
             )
                     
     	(setq mtpt_list (vl-sort mtpt_list
			  '(lambda (u v)
			    (< (car u) (car v))
			    )
			  )
 		)
     
     	  (while (setq f (car mtpt_list))
                (setq g (cdr mtpt_list))
                               
;;;			  Modified				;;;
                               
       (setq thelenght (rtos 
               (if (setq h (_relist nil))
                   (progn
                         (setq g (_relist t))
                           	(apply '+ (mapcar 'cadr (cons f h))))
                       (cadr f)) 2 [b][color="blue"]0[/color][/b]))
             
;;;			Lesson for Andy				;;;
;;;                  OPTION for 0.50 value			;;;
;;;              						;;;
;;;	(setq thelenght_fix (fix thelenght))			;;;
;;;	(setq thelenght_rem (rem thelenght thelenght_fix))	;;;
;;;	(setq thelenght						;;;
;;;		           (itoa				;;;
;;;		                 (if (>= thelenght_rem 0.50)	;;;
;;;		                       (1+ thelenght_fix)	;;;
;;;		                       thelenght_fix)))		;;;
;;;								;;;
;;;			Lesson for Andy				;;;
                               
                                           
(princ (strcat "\nThere are "
                         (itoa (if h (1+ (length h)) 1))
                         " MTEXT objects with content \""
                         (itoa (car f))
                         "mm PE\" on the current tab and the "
                                 (if h "total " "")
                         "length is " thelenght  "m."))
               (setq mtpt_list g)
	                )
	      )
  )
         (princ)
 )

That is just one approach, there are other options, like using layer names instead of '0gas' it could be ""63mm PE gas" or we could even use XDATA

How did you label those plines anyway? did you use a program? we can modify that code (if you do have one) to assign XDATA or go with the layer name thingy, its your call.

Try the demo i posted and see if that sufficient enough for your requirement

HTH

EDIT: Rounding the Total nearest 1

EDIT: RTOS from 2 2 to 2 0 1

Edited November 17, 2016 by pBe
Remove "_X" on ssget/ Update string scenarios

November 15, 2016

Nice codes pBe.

Let's hope that the drawing does not have any Mtext object stands a lone without any girlfriend , Opps I mean a polyline which may force the program to come up with odd result.

November 15, 2016

Nice codes pBe.

Let's hope that the drawing does not have any Mtext object stands a lone without any girlfriend , Opps I mean a polyline which may force the program to come up with odd result.

Thank you Tharwat.

There is that risk Tharwat, that is why i laid other options on the table for the OP. pairing would be a headache. [ perhaps remove the "_X" and force the user to select objects ]

That is also the reason why i asked the OP how they label the polylines, we could force the objects to follow a certain condition (

Anyhoo, we can always write another code

pBe

wonder how complex the actual drawing really is....

Edited November 15, 2016 by pBe

November 15, 2016

(defun C:demo  (/ ss i pl_list mt_list mtpt_list sn a b c d e f g h tmp _nearest thelenght)
(setq _relist (lambda (m)
     ((if m vl-remove-if vl-remove-if-not) '(lambda (x)
			(equal (car f) (car x))) g)))
(if (setq ss (ssget 
	       '((410 . "Model")(8 . "0gas")
	         (-4 . "<OR")
               	 (-4 . "<AND")(0 . "MTEXT")(1 . "#*mm PE")
		 (-4 . "AND>") (0 . "LWPOLYLINE") (-4 . "OR>")))
        )
	(progn          
		(repeat (setq i (sslength ss))
	              (setq sn (ssname ss (setq i (1- i))))
	                    
	              	(if (eq (cdr (assoc 0 (setq ent (entget  sn)))) "LWPOLYLINE")
	                    	(setq pl_list (cons (list (vlax-curve-getDistAtParam sn
	                                                        (vlax-curve-getendparam sn)) sn ) pl_list))
	                    	(setq mt_list (cons (list (cdr (assoc 10 ent)) (cdr (assoc 1 ent))) mt_list))
	                    )
	                    )	
		(while (and (setq a (car mt_list)) pl_list)
	                  (setq tmp (mapcar '(lambda (c)
					(list c (distance (car a)
	                                               (vlax-curve-getClosestPointTo (cadr c) (car a)))
	                                      	(car c) (cadr a)))  pl_list))
	              		(setq _nearest (car (vl-sort tmp '(lambda ( d e )
	                                                            (< (cadr d) (cadr e)))))
                                             
	                              pl_list (vl-remove (Car _nearest) pl_list)
	                              mtpt_list (cons (list   (cadddr _nearest) (caddr _nearest)) mtpt_list)
	                              mt_list (cdr mt_list))
	              )
                     
	              	(setq mtpt_list (vl-sort mtpt_list
						  '(lambda (u v)
						    (< (car u) (car v))
						    )
						  )
                                     
		  )
	      	  (while (setq f (car mtpt_list))
	                 (setq g (cdr mtpt_list))

                               (setq thelenght (rtos 
                                (if (setq h (_relist nil))
                                    (progn
                                          (setq g (_relist t))
	                                    	(apply '+ (mapcar 'cadr (cons f h))))
                                        (cadr f)) 2 2 ))                
		(princ (strcat "\nThere are "
	                         (itoa (if h (1+ (length h)) 1))
	                         " MTEXT objects with content \""
	                         (car f)
	                         "\" on the current tab and the "
                                  (if h "total " "")
	                         "length is " thelenght  "m."))
	                (setq mtpt_list g)
	                )
	      )
  )
         (princ)
 )

That is just one approach, there are other options, like using layer names instead of '0gas' it could be ""63mm PE gas" or we could even use XDATA

How did you label those plines anyway? did you use a program? we can modify that code (if you do have one) to assign XDATA or go with the layer name thingy, its your call.

Try the demo i posted and see if that sufficient enough for your requirement

HTH

Wow thank you! That is exactly what I am looking for. Just a minor tweak (hopefully). Sometimes the labels could be slightly different (63mm Pe/63 PE/63 Pe). One reason for this is that sometimes the length of pipe can be very short so the 'mm' could be removed so that it fits.

Is there a way of changing it to look for these variations? It may be easier just to look for the number that the MTEXT begins with as there shouldn't be any other text on the '0gas' layer that will interfere.

I currently use the Lee Mac dynamic label LISP to label each Polyline.

November 15, 2016

.... Wow thank you!...

Good for you.

.....Sometimes the labels could be slightly different (63mm Pe/63 PE/63 Pe)...Is there a way of changing it to look for these variations? It may be easier just to look for the number that the MTEXT begins with as there shouldn't be any other text on the '0gas' layer that will interfere...

I will let you take the first crack on this, then show us what you come up with. we'll pick up from there.

... I currently use the Lee Mac dynamic label LISP to label each Polyline.

I'll check it out, we can use LMs program to determine how we collect the data for the demo code.

November 15, 2016

Good for you.

I will let you take the first crack on this, then show us what you come up with. we'll pick up from there.

I'll check it out, we can use LMs program to determine how we collect the data for the demo code.

The closest I can get is this.........

(defun C:demo  (/ ss i pl_list mt_list mtpt_list sn a b c d e f g h tmp _nearest thelenght)
(setq _relist (lambda (m)
     ((if m vl-remove-if vl-remove-if-not) '(lambda (x)
			(equal (car f) (car x))) g)))
(if (setq ss (ssget 
	       '((410 . "Model")(8 . "0gas")
	         (-4 . "<OR")
               	 (-4 . "<AND")(0 . "MTEXT")(1 . "#****")
		 (-4 . "AND>") (0 . "LWPOLYLINE") (-4 . "OR>")))
        )
	(progn          
		(repeat (setq i (sslength ss))
	              (setq sn (ssname ss (setq i (1- i))))
	                    
	              	(if (eq (cdr (assoc 0 (setq ent (entget  sn)))) "LWPOLYLINE")
	                    	(setq pl_list (cons (list (vlax-curve-getDistAtParam sn
	                                                        (vlax-curve-getendparam sn)) sn ) pl_list))
	                    	(setq mt_list (cons (list (cdr (assoc 10 ent)) (cdr (assoc 1 ent))) mt_list))
	                    )
	                    )	
		(while (and (setq a (car mt_list)) pl_list)
	                  (setq tmp (mapcar '(lambda (c)
					(list c (distance (car a)
	                                               (vlax-curve-getClosestPointTo (cadr c) (car a)))
	                                      	(car c) (cadr a)))  pl_list))
	              		(setq _nearest (car (vl-sort tmp '(lambda ( d e )
	                                                            (< (cadr d) (cadr e)))))
                                             
	                              pl_list (vl-remove (Car _nearest) pl_list)
	                              mtpt_list (cons (list   (cadddr _nearest) (caddr _nearest)) mtpt_list)
	                              mt_list (cdr mt_list))
	              )
                     
	              	(setq mtpt_list (vl-sort mtpt_list
						  '(lambda (u v)
						    (< (car u) (car v))
						    )
						  )
                                     
		  )
	      	  (while (setq f (car mtpt_list))
	                 (setq g (cdr mtpt_list))

                               (setq thelenght (rtos 
                                (if (setq h (_relist nil))
                                    (progn
                                          (setq g (_relist t))
	                                    	(apply '+ (mapcar 'cadr (cons f h))))
                                        (cadr f)) 2 2 ))                
		(princ (strcat "\nThere are "
	                         (itoa (if h (1+ (length h)) 1))
	                         " MTEXT objects with content \""
	                         (car f)
	                         "\" on the current tab and the "
                                  (if h "total " "")
	                         "length is " thelenght  "m."))
	                (setq mtpt_list g)
	                )
	      )
  )
         (princ)
 )

I tried a few things but I must admit I am a beginner so I struggled a little!

The best I can do is substituting (-4 . "

This now lists every scenario, but they are listed individually.

My code lists it like this....

There are 1 MTEXT objects with content "63 Pe" on the current tab and the

length is 11.93m.

There are 1 MTEXT objects with content "63mm Pe" on the current tab and the

length is 2.44m.

Ideally I would like it to do this but list them as a total for each diameter.

Edited November 16, 2016 by andy_06
Code Tag added

November 15, 2016

The previous somewhat related thread:

http://www.cadtutor.net/forum/showthread.php?98447-LISP-to-display-MText-Contents&p=671463#post671463

I'm wondering why won't rename all the name variations into one global, I.e.:

 63mm PE, 63mm Pe, 63 PE, 63 Pe,  -> 63mm PE

November 15, 2016

......

I tried a few things but I must admit I am a beginner so I struggled a little!

The best I can do is substituting (-4 . "

Ideally I would like it to do this but list them as a total for each diameter.

You're almost there andy, if the MTEXT string value always ends with PE or pe, Pe, pE then try it with

(1 . "#*[Pp][Ee]")

The condition now is the string needs to start with a numeric value "#" and as long as it ends with the letter p & e.

The next step is to consolidate "similar" values"... YOU CAN DO IT andy

And learn how to use code tags.

Edited November 15, 2016 by pBe

November 15, 2016

You're almost there andy, if the MTEXT string value always ends with PE or pe, Pe, pE then try it with
(1 . "#*[Pp][Ee]")
The condition now is the string needs to start with a numeric value "#" and as long as it ends with the letter p & e.

And learn how to use code tags.

Thanks again, that now lists every scenario. The only thing now is that it lists them as separate objects like this...

There are 1 MTEXT objects with content "63mm PE" on the current tab and the

length is 25.1m.

There are 2 MTEXT objects with content "63mm Pe" on the current tab and the

total length is 20.2m.

Is it possible to list them like this (combine them):

There are 3 MTEXT objects with content "63mm Pe" on the current tab and the

total length is 45.3m.

I think it may have to look for the number (63/90/125 etc) for this to work.

November 15, 2016

You're almost there andy, if the MTEXT string value always ends with PE or pe, Pe, pE then try it with
(1 . "#*[Pp][Ee]")
The condition now is the string needs to start with a numeric value "#" and as long as it ends with the letter p & e.

The next step is to consolidate "similar" values"... YOU CAN DO IT andy

And learn how to use code tags.

Sorry I just saw this post so you already know my next question! I will have a go and let you know!

November 15, 2016

Thanks again, that now lists every scenario. The only thing now is that it lists them as separate objects like this...

There are 1 MTEXT objects with content "63mm PE" on the current tab and the

length is 25.1m.

There are 2 MTEXT objects with content "63mm Pe" on the current tab and the

total length is 20.2m.

Is it possible to list them like this (combine them):

There are 3 MTEXT objects with content "63mm Pe" on the current tab and the

total length is 45.3m.

I think it may have to look for the number (63/90/125 etc) for this to work.

Already did, updated the routine on the post where the demo code is

And please try and fix your posts with a code tag

November 15, 2016

My apologies I will remember that next time. Thanks for your help, the code does exactly what I am looking for!

November 16, 2016

Already did, updated the routine on the post where the demo code is

And please try and fix your posts with a code tag

Hi, me again.

Thanks again for the code, I have been using it and it works great.

Are you able to set it so that each length of Polyline is rounded up or down to a whole number (18.35m = 18m / 18.65m = 19m)?

November 16, 2016

Please read the Code Posting Guidelines and edit your Code to be included in Code Tags (Not HTML Tags).[NOPARSE]

Your Code Here[/NOPARSE]

=

Your Code Here

November 16, 2016

Please read the Code Posting Guidelines and edit your Code to be included in Code Tags (Not HTML Tags).[NOPARSE]
Your Code Here[/NOPARSE]
=
Your Code Here

Hopefully this is correct....

Hi, me again.

Thanks again for the code, I have been using it and it works great.

Are you able to set it so that each length of Polyline is rounded up or down to a whole number (18.35m = 18m / 18.65m = 19m)?

(defun C:demo  (/ ss i pl_list mt_list mtpt_list sn a b c d e f g h tmp _nearest thelenght)
(setq _relist (lambda (m)
     ((if m vl-remove-if vl-remove-if-not) '(lambda (x)
			(equal (car f) (car x))) g)))
(if (setq ss (ssget 
	       '((410 . "Model")(8 . "0gas")
	         (-4 . "<OR")
               	 (-4 . "<AND")(0 . "MTEXT")(1 . "#*[Pp][Ee]")
		 (-4 . "AND>") (0 . "LWPOLYLINE") (-4 . "OR>")))
        )
	(progn          
		(repeat (setq i (sslength ss))
	              (setq sn (ssname ss (setq i (1- i))))
	                    
	              	(if (eq (cdr (assoc 0 (setq ent (entget  sn)))) "LWPOLYLINE")
	                    	(setq pl_list (cons (list (vlax-curve-getDistAtParam sn
	                                                        (vlax-curve-getendparam sn)) sn ) pl_list))
	                    	(setq mt_list (cons (list (cdr (assoc 10 ent)) (atoi (cdr (assoc 1 ent)))) mt_list))
	                    )
	                    )	
		(while (and (setq a (car mt_list)) pl_list)
	                  (setq tmp (mapcar '(lambda (c)
					(list c (distance (car a)
	                                               (vlax-curve-getClosestPointTo (cadr c) (car a)))
	                                      	(car c) (cadr a)))  pl_list))
	              		(setq _nearest (car (vl-sort tmp '(lambda ( d e )
	                                                            (< (cadr d) (cadr e)))))
                                             
	                              pl_list (vl-remove (Car _nearest) pl_list)
	                              mtpt_list (cons (list   (cadddr _nearest) (caddr _nearest)) mtpt_list)
	                              mt_list (cdr mt_list))
	              )
                     
	              	(setq mtpt_list (vl-sort mtpt_list
						  '(lambda (u v)
						    (< (car u) (car v))
						    )
						  )
                                     
		  )
	      	  (while (setq f (car mtpt_list))
	                 (setq g (cdr mtpt_list))

                               (setq thelenght (rtos 
                                (if (setq h (_relist nil))
                                    (progn
                                          (setq g (_relist t))
	                                    	(apply '+ (mapcar 'cadr (cons f h))))
                                        (cadr f)) 2 2 ))                
		(princ (strcat "\nThere are "
	                         (itoa (if h (1+ (length h)) 1))
	                         " MTEXT objects with content \""
	                         (itoa (car f))
	                         "mm PE\" on the current tab and the "
                                  (if h "total " "")
	                         "length is " thelenght  "m."))
	                (setq mtpt_list g)
	                )
	      )
  )
         (princ)
 )

LISP to count MTEXT & Polylines

Recommended Posts

andy_06

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

pBe

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

pBe

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

pBe

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

pBe

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

pBe

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

Grrr

Link to comment

Share on other sites

pBe

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

pBe

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

SLW210

Link to comment

Share on other sites

andy_06

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity