LISP to count MTEXT & Polylines

 

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)?

 

Glad to be of service.

That would be a good lesson for you, hint: look into fix , 1+ and rem function.

(fix 12.34)
12
(fix 12.[b]54[/b])
12

What do you see? so you need to test the remainder value if is over or equal 0.50. then....

Glad to be of service.

 

That would be a good lesson for you, hint: look into fix , 1+ and rem function.

 

(fix 12.34)
12
(fix 12.[b]54[/b])
12

 

What do you see? so you need to test the remainder value if is over or equal 0.50. then....

Should I be altering the line below (in blue)? I have tried a few different options but I keep getting error: bad argument type: lentityp nil

	              [color="red"][color="blue"](setq sn (ssname ss (setq i (1- i))))[/color][/color]
	                      )

First of all, please refrain from posting the entire code, it creates confusion, just show the bit that you modify

Should I be altering the line below (in blue)? I have tried a few different options but I keep getting error: bad argument type: lentityp nil

Nope, it has something to do with the thelenght variable

(setq remainderfromnumber 12.34)

(setq fixnumber (fix number))

(setq remainderfromnumber (rem number fixnumber))

[ remainderfromnumber is equal to 0.50 ]

[ remainderfromnumber is higher than 0.50 ]

[ remainderfromnumber is lower than 0.50 ]

is [i]number [/i] already the target value? 

What to do next?

First of all, please refrain from posting the entire code, it creates confusion, just show the bit that you modify

 

 

 

Nope, it has something to do with the thelenght variable

 

(setq remainderfromnumber 12.34)

(setq fixnumber (fix number))

(setq remainderfromnumber (rem number fixnumber))

[ remainderfromnumber is equal to 0.50 ]

[ remainderfromnumber is higher than 0.50 ]

[ remainderfromnumber is lower than 0.50 ]

is [i]number [/i] already the target value? 

 

What to do next?

                                (setq thelenght (rtos 
                                (if (setq h (_relist nil))
                                    (progn
                                          (setq g (_relist t))
	                                    	(apply '+ (mapcar 'cadr (cons f h))))
                                        (cadr f)) 2 2 ))   

Sorry I am struggling, I think it is this section that I need to alter but I haven't managed to get anything to work. I am trying but I think this code is a little advanced for me at this stage!

Andy, Next time try harder OK?

Code updated at post # 6

Hope this helps

..And please spend some time cleaning up your other posts.

pBe

Why not use rtos?

Why not use rtos?

_$ (rtos  12.34 2 0)
"12"
_$ (rtos  12.54 2 0)
"13"
_$ 

You are absolutely right Roy_043, i did say make it simple. But during the time of the post, i am unsure as to what the intention would be if the decimal value is halfway, hence the if/cond function.

Kudos to you for bringing rtos option on the table

Thank you again for your help, the code works great

Hi,

I have been using the code in Post#6 and it has helped me massively. I am now wondering if it is possible to take it a step further and include a block that is inserted at the beginning and end of each Polyline. (The block is called "GN" and each block on the drawing has a unique number).

It would be great if the LISP could somehow export to a CSV file that lists the length and diameter of each section of pipe between each different 'GN' block).

CSV example layout:

EN EN Length Diameter

1 2 10 90mm PE

2 3 25 63mm PE

2 4 18 63mm PE

I understand that this is probably a big ask and I have been doing my best to try first before posting a request but I thought I would ask as this is way over my head.

As its a block you can export out all the attribute values to a csv. You dont need to know anything pick a block it returns name of block and all attributes in creation order.

; as simple as you can get pick a block - copy this line to command line
(foreach att (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'getattributes)(princ (strcat (vla-get-textstring att) "\n")))

; as simple as you can get pick a block - copy this line to command line
(foreach att (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'getattributes)(princ (strcat (vla-get-textstring att) "\n")))

Hi BIGAL,

I need the code to look at the GN block at each end of a polyline (labelled with an MTEXT i.e. 63mm PE) and then return the number of each block, the length of polyline inbetween each block and also the label.

I have attached an example drawing.

Test.dwg

Hi, I wonder if there is anyone on the forum that would be willing to take on the challenge of my request in Posts #29 & #31?

Thanks

See my post this will give you length between vertices.

http://www.cadtutor.net/forum/showthread.php?99275-Data-Extraction-Question

Ok in simple terms pick block 1 pick block 2 write out details

1-2 63mm PE Length=123.456

2-3 90mm PE length=43.45

You can search for objects around say the insertion point of the block in your case up to 3 by comparing block1 list and block2 list you should only have 1 object return length.

Question are you happy to pick blocks or do a entry list 2-3 1-4 5-6 etc other way may be a tree answer pick all most complicated.

This is a work in progress just need to sort a couple of bugs worked on my test but not yours mine returned length. Need to add the block start-end.

Time to go home now

Merry Christmas to all.

(defun blockatt (pt / num pt1 pt2 blobj objblk)
(setq pt1 (polar pt (/ pi 4.0) 1.0 ))
(setq pt2 (polar pt (* pi 1.25) 1.0 ))
(setq objblk (ssget "c" pt1 pt2 (list (cons 0 "INSERT")(cons 2 "GN"))))
(setq num (sslength objblk))
(if (> num 1)(alert "About to crash more than 1 block"))
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname objblk 0)) 'getattributes)
(if (= "1" (strcase (vla-get-tagstring att)))
(setq Blkatt (vla-get-textstring att)) 
)
)
)

; starts here
(defun c:test ( / len obj objs stpt endpt blkatt att1 att2)
(setq objs (ssget  (list (cons 0 "line,lwpolyline"))))
(repeat (setq x (sslength objs))
(setq obj (vlax-ename->vla-object (ssname objs (setq x (- x 1)))))
(setq stpt  (vlax-curve-getstartpoint  obj))
(setq endpt (vlax-curve-getendpoint  obj))
(setq len (rtos (vla-get-length obj) 2 2))
(blockatt stpt)
(setq att1 blkatt)
(blockatt endpt)
(setq att2 blkatt)
(alert (strcat "Blk-" att1 " Blk-" att2 " Length is " len))
)
)

This is a work in progress just need to sort a couple of bugs worked on my test but not yours mine returned length. Need to add the block start-end.

 

Time to go home now

 

Merry Christmas to all.

(defun obspt (/ inspt pt1 pt2 objs) 
(setq inspt (cdr (assoc 10 (entget (car (entsel))))))
(setq pt1 (polar inspt (/ pi 4.0) 0.35 ))
(setq pt2 (polar inspt (* pi 1.25) 0.35 ))
(setq objs (ssget "c" pt1 pt2 (list (cons 0 "line,lwpolyline"))))
(setq lst '())
(repeat (setq x (sslength objs))
(setq lst (cons (ssname objs (setq x (- x 1))) lst))
)
)
(obspt)
(setq lst1 lst)
(setq lst '())
(obspt)
(setq lst2 lst)
; now do checking
(repeat (setq x (length lst1))
(setq obj1h (vla-get-Handle (vlax-ename->vla-object (nth (setq x (- x 1)) lst1))))
(repeat (setq y (length lst2))
(setq obj2 (vlax-ename->vla-object (nth (setq y (- y 1)) lst2)))
(setq obj2h (vla-get-Handle obj2))
(if (= obj1h obj2h)
(alert (strcat "length is " (rtos (vla-get-length obj2) 2 2)))
(princ "miss")
)
)
)

Hi BIGAL! Thanks a lot for your help, I will have a look and see if I can suggest anything. Ideally I would like it to select all Polylines/labels/'GN' blocks in the drawing and return a list.

At the moment it returns the lengths one after another so it is on the right track!

Merry Christmas to you too.

Glad that part works, need to build the "Tree search" finding pairs of blocks, thinking about it now may go about it a different way and get all plines 1st then look for blocks on each end then use the defun already done

See revised code above its a bit crude but can be enhanced regarding output but works.

I am not going to try to match pipe type as this is something you need to do from drafting standards control, draw the pipes on correct layer 63mm etc you can add layer to output, vla-get-layer obj

Very good thinking BIGAL,

It was interesting for me to analyse it, so wrote something similair (just to practice) :

(defun C:test ( / GetLen foo bnm AttTag SS i Lst )
 (setq ; adjust blockname and attrib tag here
   bnm "GN"
   AttTag "1"
 ); setq
 
 (defun GetLen ( han / e enx Lst )
   (if
     (and
       (eq 'STR (type han))
       (setq e (handent han))
       (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget e)))))
       (/= 1 (cdr (assoc 70 enx)))
       (setq Lst (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) enx)))
       (setq Lst (list (car Lst) (last Lst)))
     )
     (rtos (vlax-curve-getDistAtPoint e (last Lst)) 2 2)
   )
 ); defun GetLen
 
 
 (defun foo ( e bnm AttTag / enx Lst dst SS i o p AttVal Lst2 )
   (if
     (and 
       (vl-every '(lambda (a b) (eq a b)) (mapcar 'type (list bnm AttTag e)) (list 'STR 'STR 'ENAME))
       (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget e)))))
       (/= 1 (cdr (assoc 70 enx)))
       (setq Lst (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) enx)))
       (setq Lst (list (car Lst) (last Lst)))
       (setq SS (ssget "_F" Lst (list (cons 0 "INSERT"))))
     )
     (progn
       (repeat (setq i (sslength SS))
         (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i)))))
         (and
           (eq (vla-get-EffectiveName o) bnm)
           (eq (vla-get-HasAttributes o) :vlax-true)
           (or
             (equal (reverse (cdr (reverse (vlax-get o 'InsertionPoint)))) (setq p (car Lst)) 1e-2)
             (equal (reverse (cdr (reverse (vlax-get o 'InsertionPoint)))) (setq p (last Lst)) 1e-2)
           )
           (setq AttVal
           (vl-some 
             '(lambda (x) (if (eq (vla-get-TagString x) AttTag) (vla-get-TextString x)))
             (vlax-invoke o 'GetAttributes)
           )
           )
           (not (vl-some '(lambda (x) (equal (cons AttVal (list p)) x)) Lst2))
           (setq Lst2 (cons (cons AttVal (list p)) Lst2))
         ); and
       ); repeat 
       (if
         (and
           Lst2
           (vl-some '(lambda (x) (equal (car Lst) x 1e-2)) (mapcar 'cadr Lst2))
           (vl-some '(lambda (x) (equal (last Lst) x 1e-2)) (mapcar 'cadr Lst2))
         )
         (setq Lst2 (list (cdr (assoc 5 enx)) (reverse (mapcar 'car Lst2))))
         (setq Lst2 nil)
       )
     ); progn
   ); if
   Lst2
 ); defun foo
 
 (if (setq SS (ssget (list (cons 0 "LWPOLYLINE"))))
   (repeat (setq i (sslength SS))
     (setq Lst (cons (foo (ssname SS (setq i (1- i))) bnm AttTag) Lst))
   )
 )
 (if Lst 
   (alert
     (apply 'strcat
       (mapcar 
         (function 
           (lambda (x)
             (strcat
               "\nDistance: "
               (GetLen (car x))
               " on labels: "
               (vl-string-right-trim "-" (apply 'strcat (mapcar '(lambda (c) (strcat c "-")) (cadr x))))
             )
           )
         )
         (vl-remove nil (reverse Lst))
       )
     )
   )
 )
 (princ)
);| defun C:test |; (vl-load-com) (princ)

Although it works only with LWPOLYLINES.

Very good thinking BIGAL,

It was interesting for me to analyse it, so wrote something similair (just to practice) :

 

(defun C:test ( / GetLen foo bnm AttTag SS i Lst )
 (setq ; adjust blockname and attrib tag here
   bnm "GN"
   AttTag "1"
 ); setq
 
 (defun GetLen ( han / e enx Lst )
   (if
     (and
       (eq 'STR (type han))
       (setq e (handent han))
       (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget e)))))
       (/= 1 (cdr (assoc 70 enx)))
       (setq Lst (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) enx)))
       (setq Lst (list (car Lst) (last Lst)))
     )
     (rtos (vlax-curve-getDistAtPoint e (last Lst)) 2 2)
   )
 ); defun GetLen
 
 
 (defun foo ( e bnm AttTag / enx Lst dst SS i o p AttVal Lst2 )
   (if
     (and 
       (vl-every '(lambda (a b) (eq a b)) (mapcar 'type (list bnm AttTag e)) (list 'STR 'STR 'ENAME))
       (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget e)))))
       (/= 1 (cdr (assoc 70 enx)))
       (setq Lst (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) enx)))
       (setq Lst (list (car Lst) (last Lst)))
       (setq SS (ssget "_F" Lst (list (cons 0 "INSERT"))))
     )
     (progn
       (repeat (setq i (sslength SS))
         (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i)))))
         (and
           (eq (vla-get-EffectiveName o) bnm)
           (eq (vla-get-HasAttributes o) :vlax-true)
           (or
             (equal (reverse (cdr (reverse (vlax-get o 'InsertionPoint)))) (setq p (car Lst)) 1e-2)
             (equal (reverse (cdr (reverse (vlax-get o 'InsertionPoint)))) (setq p (last Lst)) 1e-2)
           )
           (setq AttVal
           (vl-some 
             '(lambda (x) (if (eq (vla-get-TagString x) AttTag) (vla-get-TextString x)))
             (vlax-invoke o 'GetAttributes)
           )
           )
           (not (vl-some '(lambda (x) (equal (cons AttVal (list p)) x)) Lst2))
           (setq Lst2 (cons (cons AttVal (list p)) Lst2))
         ); and
       ); repeat 
       (if
         (and
           Lst2
           (vl-some '(lambda (x) (equal (car Lst) x 1e-2)) (mapcar 'cadr Lst2))
           (vl-some '(lambda (x) (equal (last Lst) x 1e-2)) (mapcar 'cadr Lst2))
         )
         (setq Lst2 (list (cdr (assoc 5 enx)) (reverse (mapcar 'car Lst2))))
         (setq Lst2 nil)
       )
     ); progn
   ); if
   Lst2
 ); defun foo
 
 (if (setq SS (ssget (list (cons 0 "LWPOLYLINE"))))
   (repeat (setq i (sslength SS))
     (setq Lst (cons (foo (ssname SS (setq i (1- i))) bnm AttTag) Lst))
   )
 )
 (if Lst 
   (alert
     (apply 'strcat
       (mapcar 
         (function 
           (lambda (x)
             (strcat
               "\nDistance: "
               (GetLen (car x))
               " on labels: "
               (vl-string-right-trim "-" (apply 'strcat (mapcar '(lambda (c) (strcat c "-")) (cadr x))))
             )
           )
         )
         (vl-remove nil (reverse Lst))
       )
     )
   )
 )
 (princ)
);| defun C:test |; (vl-load-com) (princ)

 

Although it works only with LWPOLYLINES.

Hi Grrr,

Thanks again for your help. I have tested that and it is pretty much exactly what I am looking for. Is it also possible to incorporate the diameter label as well? The reason for this code is so that I can check the distance and pipe diameter (63mm/90mm etc) between each "GN" block.

It would also be helpful if the data could be exported to a CSV file but this isn't as important if that is alot of extra work.

Thanks