Jump to content

LISP to count MTEXT & Polylines


andy_06

Recommended Posts

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

 

Hi,

Thats not so easy thing to do. Currently my suggestion is based on BIGAL's idea, about finding if there are such attributed "GN" blocks on both ends per polyline and constructing an assoc list of

( ). However its possible to incorporate with pBe's algorithm, but I would rather suggest his code to be modified to attach xdata with diameter value for every pline, so it then could be easily extracted from there, instead of performing a search for every polyline about finding the nearest text object (that labels it).

Link to comment
Share on other sites

  • Replies 66
  • Created
  • Last Reply

Top Posters In This Topic

  • andy_06

    32

  • pBe

    17

  • BIGAL

    10

  • Grrr

    5

Top Posters In This Topic

Hi,

Thats not so easy thing to do. Currently my suggestion is based on BIGAL's idea, about finding if there are such attributed "GN" blocks on both ends per polyline and constructing an assoc list of

( ). However its possible to incorporate with pBe's algorithm, but I would rather suggest his code to be modified to attach xdata with diameter value for every pline, so it then could be easily extracted from there, instead of performing a search for every polyline about finding the nearest text object (that labels it).

 

OK thanks, I must say I have never used XDATA. I have just looked into it and as far as I can see it is a way of adding attributes to an object? Is there any particular attribute I should add to the labels? And is there a way of pre-setting these?

Edited by andy_06
Link to comment
Share on other sites

I have just looked into it and as far as I can see it is a way of adding attributes to an object?

Yes, basically attaching additional info to an object.

Is there any particular attribute I should add to the labels?

For example automatically extract the content of the text that labels the certain polyline, and assign it to that same polyline as xdata.

And is there a way of pre-setting these?

Yes, here are simple examples of attaching and retrieving XDATA, registered under "Diameter" application:

 

(defun C:testAssign ( / e enx xDnm XDcont thedata)
 (and
   (setq e (car (entsel "\nSelect object to assign xdata: ")))
   (setq enx (entget e))
   (setq XDnm "Diameter") ; Xdata's name
   (not (initget 1))
   (setq XDcont (getstring t "\nType the Xdata content: ")) 
   (progn (regapp XDnm) T)
   (setq thedata (list (list -3 (list XDnm (cons 1000 XDcont)))))
   (entmod (append enx thedata))
   (alert (strcat "\nApplied XDATA content: \"" XDcont "\", registered inside of: \"" XDnm "\" !"))
 )
 (princ)
)

 

(defun C:testRetrieve ( / e XDnm enx RetCont )
(if
   (and
     (setq e (car (entsel "\nSelect object to retrieve xdata: ")))
     (setq XDnm "Diameter") ; Xdata's name
     (setq enx (entget e (list XDnm)))
     (setq RetCont (cdr (cadr (car (cdr (assoc -3 enx))))))
   )
   (alert (strcat "\nThe object's XDATA content is: \"" RetCont "\", registered inside of: \"" XDnm "\" !"))
   (and e (alert "\n* The object doesn't contain XDATA! *"))
 )
 (princ)
)

 

Once that info is assigned for each polyline, then you could easily retrieve it with lisp, without having to look for nearest text objects that are used to label it.

Link to comment
Share on other sites

Yes, basically attaching additional info to an object.

 

For example automatically extract the content of the text that labels the certain polyline, and assign it to that same polyline as xdata.

 

Yes, here are simple examples of attaching and retrieving XDATA, registered under "Diameter" application:

 

(defun C:testAssign ( / e enx xDnm XDcont thedata)
 (and
   (setq e (car (entsel "\nSelect object to assign xdata: ")))
   (setq enx (entget e))
   (setq XDnm "Diameter") ; Xdata's name
   (not (initget 1))
   (setq XDcont (getstring t "\nType the Xdata content: ")) 
   (progn (regapp XDnm) T)
   (setq thedata (list (list -3 (list XDnm (cons 1000 XDcont)))))
   (entmod (append enx thedata))
   (alert (strcat "\nApplied XDATA content: \"" XDcont "\", registered inside of: \"" XDnm "\" !"))
 )
 (princ)
)

 

(defun C:testRetrieve ( / e XDnm enx RetCont )
(if
   (and
     (setq e (car (entsel "\nSelect object to retrieve xdata: ")))
     (setq XDnm "Diameter") ; Xdata's name
     (setq enx (entget e (list XDnm)))
     (setq RetCont (cdr (cadr (car (cdr (assoc -3 enx))))))
   )
   (alert (strcat "\nThe object's XDATA content is: \"" RetCont "\", registered inside of: \"" XDnm "\" !"))
   (and e (alert "\n* The object doesn't contain XDATA! *"))
 )
 (princ)
)

 

Once that info is assigned for each polyline, then you could easily retrieve it with lisp, without having to look for nearest text objects that are used to label it.

 

OK thanks for that, I have used the above codes and I can now see the reasoning behind it adding the XDATA.

Do you have to go around each individual polyline to assign the diameter? As I could have drawings with hundreds of individual Polylines. Or is this where the LISP routine comes in?

I have re-attached my test drawing which now includes the diameter on each Polyline.

Test.dwg

Link to comment
Share on other sites

Do you have to go around each individual polyline to assign the diameter?

As I could have drawings with hundreds of individual Polylines.

Not necessary, as I've mentioned pBe's routine could attach the nearest text content, that labels the pline as xdata.

I have re-attached my test drawing which now includes the diameter on each Polyline.

Now when every pline has that additional info its easy to retrieve it with the code:

(defun C:test ( / GetLen GetX 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
 
 ; (GetX (cdr (assoc 5 (entget (car (entsel))))) "Diameter")
 (defun GetX ( han appname / e rtn )
   (and
     (eq 'STR (type han))
     (setq e (handent han))
     (tblsearch "APPID" appname)
     (setq enx (entget e (list appname)))
     (setq rtn (cdr (assoc 1000 (cdr (assoc appname (cdr (assoc -3 enx)))))))
   )
   rtn
 ); defun GetX
 
 (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 / d)
             (strcat
               "\nDistance: "
               (GetLen (car x))
               " on labels: "
               (vl-string-right-trim "-" (apply 'strcat (mapcar '(lambda (c) (strcat c "-")) (cadr x))))
               (if (setq d (GetX (car x) "Diameter"))
                 (strcat " with Diameter: " d)
                 ""
               )
             )
           )
         )
         (vl-remove nil (reverse Lst))
       )
     )
   )
 )
 (princ)
);| defun C:test |; (vl-load-com) (princ)

Link to comment
Share on other sites

Again I state good drafting practice would be to use layers rather than over complicate the need for code. You can use Dataextraction to find all 63m etc

 

Create some toolbar menus with the pipe sizes or have a lisp that is pipe size. If you want a toolbar let me know.

 

; add this to acaddoc.lsp 
(defun c:63 ()
(command "-layer" "m" "63 mm PE" "c" 1  "63 mm PE" "LT" "dashed"  "63 mm PE") ; should use a template with this layer in it
;(servar "clayer" "63 mm PE")
(command "pline")
)
(defun c:90 ()
(servar "clayer" "90 mm PE") ; expects layer exsits
(command "pline")
)

Link to comment
Share on other sites

Again I state good drafting practice would be to use layers rather than over complicate the need for code. You can use Dataextraction to find all 63m etc

 

Create some toolbar menus with the pipe sizes or have a lisp that is pipe size. If you want a toolbar let me know.

 

; add this to acaddoc.lsp 
(defun c:63 ()
(command "-layer" "m" "63 mm PE" "c" 1  "63 mm PE" "LT" "dashed"  "63 mm PE") ; should use a template with this layer in it
;(servar "clayer" "63 mm PE")
(command "pline")
)
(defun c:90 ()
(servar "clayer" "90 mm PE") ; expects layer exsits
(command "pline")
)

 

Thanks, I really like this idea. I already label the pipes using toolbar commands but hadn't thought of putting each label on their own layers. The only issue that may arise with this is that I use set frameworks for different clients & these have particular layers so I may not be able to alter these but I will look into it.

Link to comment
Share on other sites

(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

 

Hi pBe,

 

You may or may not have seen in post #45 that Grrr & BigAl has been helping me take this a step further. I am looking for the code to also include the 'GN' blocks so that I can see the length and diameter between each 'GN' block. They have written a code which does this but it requires diameter Xdata being added to each Polyline depending on the label that is closest to it (63mm/90mm etc). Grrr suggested updating your code above. Any assistance would be greatly appreciated!

Edited by andy_06
Link to comment
Share on other sites

Again ignore text thats a red herring, draw the connecting links on the correct layer. (vla-get-layer obj) just add to code.

 

Hi,

When you say draw the connecting links on the correct layer do you mean as per your code in post #46? I don't think this is going to be an option as the layers are quite strict on some of my client's templates.

I was hoping that pBe's code could be altered to include a routine that adds the diameter Xdata as per post #43 (depending on which label is closest).

Link to comment
Share on other sites

If you have to draw the pipes on one layer then look at creating the xdata at this point not as a after thought, the pipe text would still be that just text. Need a lisp draw pline then text then xdata.

 

 

; original code posted 
; http://www.cadtutor.net/forum/showthread.php?98802-LISP-to-count-MTEXT-amp-Polylines/page3

(defun GrrAssignxd (Xdcont / e enx xDnm thedata)
(and
(setq enx (entget (entlast)))
(setq XDnm "Diameter") ; Xdata's name
(not (initget 1))
(progn (regapp XDnm) T)
(setq thedata (list (list -3 (list XDnm (cons 1000 XDcont)))))
(entmod (append enx thedata))
(alert (strcat "\nApplied XDATA content: \"" XDcont "\", registered inside of: \"" XDnm "\" !"))
)
(princ)
)

(defun c:pipelables ( / xdcont)
; create pline by picking points press enter when finished
(command "_pline")
(while (= (getvar "cmdactive") 1 ) (command pause)
)

(setq xdcont (getstring t "\nType the Pipe details : "))

(GrrAssignxd xdcont)

(command "text" (getpoint) 90 xdcont ) ;depends on text style 

)

Link to comment
Share on other sites

If you have to draw the pipes on one layer then look at creating the xdata at this point not as a after thought, the pipe text would still be that just text. Need a lisp draw pline then text then xdata.

 

 

; original code posted 
; http://www.cadtutor.net/forum/showthread.php?98802-LISP-to-count-MTEXT-amp-Polylines/page3

(defun GrrAssignxd (Xdcont / e enx xDnm thedata)
(and
(setq enx (entget (entlast)))
(setq XDnm "Diameter") ; Xdata's name
(not (initget 1))
(progn (regapp XDnm) T)
(setq thedata (list (list -3 (list XDnm (cons 1000 XDcont)))))
(entmod (append enx thedata))
(alert (strcat "\nApplied XDATA content: \"" XDcont "\", registered inside of: \"" XDnm "\" !"))
)
(princ)
)

(defun c:pipelables ( / xdcont)
; create pline by picking points press enter when finished
(command "_pline")
(while (= (getvar "cmdactive") 1 ) (command pause)
)

(setq xdcont (getstring t "\nType the Pipe details : "))

(GrrAssignxd xdcont)

(command "text" (getpoint) 90 xdcont ) ;depends on text style 

)

 

Unfortunately I draw the polylines at the beginning and then run calcs to size each section. They are then labelled at the end so I don't know the diameter (63mm/90mm etc) until after they have been drawn. So the reason for this code is to do a final check to see that each section of pipe has been labelled correctly & to also check the lengths between each GN block if that makes sense. Sorry to be awkward!

Link to comment
Share on other sites

I have re arranged all the code so it allows you to draw a pline add a text label anything you want like "xx" work out your pipe size and use the 60 or 90 etc to update the pline and text value. It still uses the xdata but its really not necessary as the plines are changed to correct size layer.

 

; add all this to acaddoc.lsp or load as a seperate lisp
(vla-load-com)

(defun laysearch ( lay / )
(if (= (tblsearch "LAYER" lay) T)
(princ)
(command "-layer" "m" lay "c" 1  lay "LT" "dashed" lay "s" lay "") 
)
)

; should use a template with the PE layers in it
(defun c:63 ( / lay)
(laysearch (setq lay "63 mm PE"))
(setq obj (entsel "Pick Pline or Line"))
(command "chprop" obj "" "La" lay "")
(vla-put-textstring (vlax-ename->vla-object (car (entsel "\nPick Text "))) lay)
(GrrAssignxd lay obj )
)

(defun c:90 ( / lay)
(laysearch (setq lay "90 mm PE"))
(setq obj (entsel "Pick Pline or Line"))
(command "chprop" obj "" "La" lay "")
(vla-put-textstring (vlax-ename->vla-object (car (entsel "\nPick Text "))) lay)
(GrrAssignxd lay obj )
)

; original code posted 
; http://www.cadtutor.net/forum/showthread.php?98802-LISP-to-count-MTEXT-amp-Polylines/page3

(defun GrrAssignxd (Xdcont obj / e enx xDnm thedata)
(and
(setq enx (entget (car obj)))
(setq XDnm "Diameter")
(not (initget 1))
(progn (regapp XDnm) T)
(setq thedata (list (list -3 (list XDnm (cons 1000 XDcont)))))
(entmod (append enx thedata))
(alert (strcat "\nApplied XDATA content: \"" XDcont "\", registered inside of: \"" XDnm "\" !"))
)
(princ)
)

; create pline by picking points press enter when finished
(defun c:pipelabels ( / xdcont)
(command "_pline")
(while (= (getvar "cmdactive") 1 ) (command pause)
)
(setq xdcont (getstring t "\nType the Pipe details temp use xx : "))
(setq pt1 (getpoint "Pick text location"))
(setq pt2 (getpoint pt1 "Pick angle "))
(command "text" pt1 (angle pt1 pt2) xdcont);depends on text style needs a bit more enhancing.
)

Link to comment
Share on other sites

I have re arranged all the code so it allows you to draw a pline add a text label anything you want like "xx" work out your pipe size and use the 60 or 90 etc to update the pline and text value. It still uses the xdata but its really not necessary as the plines are changed to correct size layer.

 

; add all this to acaddoc.lsp or load as a seperate lisp
(vla-load-com)

(defun laysearch ( lay / )
(if (= (tblsearch "LAYER" lay) T)
(princ)
(command "-layer" "m" lay "c" 1  lay "LT" "dashed" lay "s" lay "") 
)
)

; should use a template with the PE layers in it
(defun c:63 ( / lay)
(laysearch (setq lay "63 mm PE"))
(setq obj (entsel "Pick Pline or Line"))
(command "chprop" obj "" "La" lay "")
(vla-put-textstring (vlax-ename->vla-object (car (entsel "\nPick Text "))) lay)
(GrrAssignxd lay obj )
)

(defun c:90 ( / lay)
(laysearch (setq lay "90 mm PE"))
(setq obj (entsel "Pick Pline or Line"))
(command "chprop" obj "" "La" lay "")
(vla-put-textstring (vlax-ename->vla-object (car (entsel "\nPick Text "))) lay)
(GrrAssignxd lay obj )
)

; original code posted 
; http://www.cadtutor.net/forum/showthread.php?98802-LISP-to-count-MTEXT-amp-Polylines/page3

(defun GrrAssignxd (Xdcont obj / e enx xDnm thedata)
(and
(setq enx (entget (car obj)))
(setq XDnm "Diameter")
(not (initget 1))
(progn (regapp XDnm) T)
(setq thedata (list (list -3 (list XDnm (cons 1000 XDcont)))))
(entmod (append enx thedata))
(alert (strcat "\nApplied XDATA content: \"" XDcont "\", registered inside of: \"" XDnm "\" !"))
)
(princ)
)

; create pline by picking points press enter when finished
(defun c:pipelabels ( / xdcont)
(command "_pline")
(while (= (getvar "cmdactive") 1 ) (command pause)
)
(setq xdcont (getstring t "\nType the Pipe details temp use xx : "))
(setq pt1 (getpoint "Pick text location"))
(setq pt2 (getpoint pt1 "Pick angle "))
(command "text" pt1 (angle pt1 pt2) xdcont);depends on text style needs a bit more enhancing.
)

 

Hi BIGAL,

 

Thanks for that, I have tested the code and I can see how it works which is great! The main issue I have is that there could be drawings with hundreds of polylines so it would be very time consuming to go around every polyline adding the XDATA. The ideal situation would be to run a code which adds the XDATA diameter depending on the nearest label (like pBe's code which gives the length of polyline depending on the label next to it).

 

Thanks

Link to comment
Share on other sites

  • 10 months later...

Hi, I have been using the code below (as written by pBe) & it has helped me massively! At the moment it looks for a label (63mm PE/90mm PE etc) and then calculates the length of the nearest polyline which enables me to check drawings easily.

 

I am wondering if there is anybody that can help me develop this code as I would love to be able to export extra data to a CSV.

 

Here is what I am looking for but it is way beyond me.....at the end of each polyline is a block called 'GN' and each 'GN' block has a unique number. If possible I would like a LISP that gives me the 'GN' number at the end of each polyline, the length of polyline in between each 'GN' block and the label closest to each polyline (i.e 4 x columns of data exported to a CSV). I have briefly asked about this before in this thread but never quite cracked it so I would really appreciate any suggestions.

 

(defun C:checklabellp  (/ 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")(62 . 256)
	         (-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 
               (if (setq h (_relist nil))
                   (progn
                         (setq g (_relist t))
                           	(apply '+ (mapcar 'cadr (cons f h))))
                       (cadr f)))
       
    	(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)))
                               
;;;			Modified			;;;
                               
                                           
	(princ (strcat "\nThere are "
	                         (itoa (if h (1+ (length h)) 1))
	                         " x \""
	                         (itoa (car f))
	                         "mm PE\" on the drawing and the "
                                  (if h "total " "")
	                         "length is " thelenght  "m."))
	                (setq mtpt_list g)
	                )
	      )
  )
         (princ)
 )

Link to comment
Share on other sites

...... If possible I would like a LISP that gives me the 'GN' number at the end of each polyline, the length of polyline in between each 'GN' block and the label closest to each polyline...

 

How's that again? closest and not touching at all?

Link to comment
Share on other sites

How's that again? closest and not touching at all?

 

Hi pBe, the labels are offset from each polyline so it is closest (not touching). The GN blocks are touching the end of each polyline though.

I hope that makes sense, if not I can upload an example drawing.

Link to comment
Share on other sites

Yes please

 

 

Please see attached CAD drawing showing an example of a drawing that I would use this on.

I would ideally like the CSV to show the data in 4 columns as follows:

 

 

Node Node Diameter Length

1_____3_____63_____14

 

3_____12____125____10

 

 

Thanks

CAD Test.dwg

Link to comment
Share on other sites

Node Node Diameter Length

1_____3_____63_____14

 

3_____12____125____10

 

Does the diameter column include the description [mm PE]? Please clarify, in another post its

 

EN EN Length Diameter

1 2 10 90mm PE

2 3 25 63mm PE

2 4 18 63mm PE

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...