adding data to polyline and extracting this data to table?

[feargt]

Hi,

Firstly I'd like to wish everyone a happy new year but it seems clear for some it has not been the best start possible, fingers crossed things improve for ye guys.

There may already be a thread with the info that I'm looking for but I have not been able to locate it.

Am looking for a lisp file or VB routine or help in creating such a file,...

where I can select a polyline (representing a pipe for example)& it will ask me
Nr 1
from where it comes?

& I can manually enter the data or select a block from where it comes and it will use the block name as the data.

Nr 2
to where it is going? again I can manually enter the data or select a block from where it comes and it will use the block name as the data.

Nr 3
It will store this info along with the width of the polyline and the layer of the polyline so that I can extract this info into a table

In my search for this I have found several ways of adding data to the polyine but not in a way that I can extract it through use of Data extraction method. It does not have to work using data extraction method but should be exportable into a table format

Any help here would be much appreciated.

This should work with plain Autocad 2008 upwards.

hope I've explained it clear enough

Thanks

[Lee Mac]

I didn't know you could add extra information to a polyline - I'd be interested to see the result of this

[ASMI]

Very simplified example write and read data to polyline (or any other object):

(defun c:dwrite(/ plObj stBl enBl datLst)
  (vl-load-com)
  (if
    (and
      (setq plObj(entsel "\nSelect polyline to write > "))
      (setq stBl(entsel "\nSelect 'start' block > "))
      (setq enBl(entsel "\nSelect 'end' block > "))
      ); end and
    (progn
    (setq plObj(vlax-ename->vla-object(car plObj))
	  stBl(cdr(assoc 2(entget(car stBl))))
	  enBl(cdr(assoc 2(entget(car enBl))))
	  datLst(list(cons 1 stBl)(cons 2 enBl))
	  ); end setq
    (vlax-ldata-put plObj "Pipe Data" datLst)
    ); end progn
   );end if
  (princ)
  ); c:dwrite
  

(defun c:dread(/ rObj datLst)
  (vl-load-com)
  (if(and
       (setq rObj(entsel "\nSelect polyline to read > "))
       (setq datLst(vlax-ldata-get(car rObj) "Pipe Data"))
       ); and
    (alert(strcat "Start block: "(cdr(assoc 1 datLst))
                  "\n\nEnd block: "(cdr(assoc 2 datLst))))
    (alert "\nNo data found. ")
    ); end if
  (princ)
  ); end of c:dread

[Lee Mac]

Cheers ASMI, thats good to know

[ASMI]

New variant with Hyperlink hints and save data to *.csv file. DWRITE- to add data to polyline, DCOLLECT -to read to *.csv file (opens with MS Excel).

(defun c:dwrite(/ plObj stBl enBl datLst cAns hyObj)
  (if
    (and
      (setq plObj(entsel "\nSelect polyline to write > "))
      (setq stBl(entsel "\nSelect 'Begin' block > "))
      (setq enBl(entsel "\nSelect 'End' block > "))
      ); end and
    (progn
    (setq plObj(vlax-ename->vla-object(car plObj))
	  stBl(cdr(assoc 2(entget(car stBl))))
	  enBl(cdr(assoc 2(entget(car enBl))))
	  datLst(list(cons 1 stBl)(cons 2 enBl))
	  hyObj(vla-get-Hyperlinks plObj)
	  ); end setq
    (if(vlax-ldata-get plObj "Pipe Data")
      (progn
	(initget "Yes No")
	(setq cAns(getkword "\nPipe data already exists. Overwrite? [Yes/No]: "))
	(if(= "Yes" cAns)
	  (progn
	   (vlax-ldata-delete plObj "Pipe Data")
	   (vlax-ldata-put plObj "Pipe Data" datLst)
	   (vla-Delete(vla-Item hyObj 0))
	   (vla-Add hyObj "Has Pipe Data" (strcat "Pipe: " stBl " --> " enBl))
	   (princ "\nData successfuly added ")
	   );end progn
	  ); end if
	); end progn
      (progn
       (vlax-ldata-put plObj "Pipe Data" datLst)
       (vla-Add hyObj "Has Pipe Data" (strcat "Pipe: " stBl " --> " enBl))
       (princ "\nData successfuly added ")
       ); end progn
      ); end if
    ); end progn
   );end if
  (princ)
  ); c:dwrite


(defun c:dcollect(/ plSet oLst cDat fName cAns exApp wbCol cDoc)
  (if(setq plSet(ssget "_X" '((0 . "LWPOLYLINE"))))
    (progn
      (foreach pl (mapcar 'vlax-ename->vla-object
                     (vl-remove-if 'listp
                       (mapcar 'cadr(ssnamex plSet))))
	(if(setq cDat(vlax-ldata-get pl "Pipe Data"))
	  (progn
	    (setq oLst(cons
			(list
			     (vla-get-ConstantWidth pl)
			     (vla-get-Layer pl)
			     (cdr(assoc 1 cDat))
			     (cdr(assoc 2 cDat))
			    ); end list
		      oLst); end cons
		  ); end setq
	    ); end progn
	  ); end if
	); end foreach
      (if oLst
	(progn
	  (setq fDescr(open
			(setq fName(strcat(vl-filename-directory(getvar "SAVENAME"))
			  "\\"(vl-filename-base(getvar "DWGNAME")) ".csv")) "w"))
	  (write-line "Diameter;Layer;From;To" fDescr)
	  (foreach itm (reverse oLst)
	      (write-line (strcat(rtos(car itm))
				 ";" (cadr itm)
				 ";" (nth 2 itm)
				 ";" (last itm))
		fDescr)
	    ); end foreach
	  (close fDescr)
	  (princ(strcat "\nCSV file location: " fName ))
	  (initget "Yes No")
	  (setq cAns(getkword "\nOpen file [Yes/No]: "))
	  (if(= cAns "Yes")
	    (if(setq exApp(vlax-get-or-create-object "Excel.Application"))
	      (progn
		(vlax-put-property exApp 'Visible :vlax-true)
	        (setq wbCol(vlax-get-property exApp 'Workbooks)
		      cDoc(vlax-invoke-method wbCol 'Open fName))
		(vlax-release-object cDoc)
		(vlax-release-object wbCol)
		(vlax-release-object exApp)
		); end progn
	      ); end if
	    ); end if
	  ); end progn
	); end if
      ); end progn
    ); end if
  (princ)
  ); end of c:dtable

(vl-load-com)

Hiperlinks is only hints with pipe direction and CTRL+Click do not work. It shows how datas exists only.

[feargt]

Thanks Asmi,

that's great!! you never cease to amaze me that is for sure. I have tested out your revised version. And naturally it is only after testing that I realise there are few extra points that I should have thought about first. I'll list a few points and maybe if you have time you could implement them, even better would be if you could put comment in the lisp file to show how u made the changes.

1. There will not always be a start block and not always an end block. Would it be possible then to give this data in as a text string when no block is availbale for selection?

2. My fault here but I completely forgot one of the main pieces of data that i need exported. That is the LENGHT of the polyline

3. Is it possible during the export to multiply the constantwidth by a thousand and prefix the number with DN (an example would be polyline with a constant width of 0.2 would export as DN 200. This is not overly important as I can do that as part of a macro in excel to format the .csv file. But would be nice to see how it is accomplished.

4. This is only something that came to me while testing. Would it be possible to create an option to request for pipe material? and if material is not known then it records a default value of N/A for not available?

1 & 2 would be needed & 3 & 4 are more of a wishlist if such a thing is allowed and would be much appreciated.

Thanks again ASMI,

Feargt

[Lee Mac]

ASMI, you are a genius.

[ASMI]

I seem have executed your wishes, but there can be bugs because it 'on fly' code. It was not exposed to serious check. Modify Materials List and Default Material at begin of code. Commands as before DWRITE and DCOLLECT. Probably it is necessary to provide a command for removal of data and hyperlinks, but not today.

(defun c:dwrite(/ plObj stBl enBl datLst cAns hyObj okFlg cMat mLst mNum)

; ************ MODIFY LIST OF MATERIALS ************

  (setq mLst '(
	       (0 . "N/A")
	       (1 . "DIN 2391")
	       (2 . "DIN 2392")
	       (3 . "DIN 2394")
	       )
	); end setq
  

; ************ MODIFY DEFAULT MATERIAL ************

  (if(not dwrite:material)
     (setq dwrite:material "N/A")
    ); end if
  
  
  
  (defun Entsel_or_Text(Spaces Message / lChr tStr grLst filPt
			selSet outVal pSps)
  (princ Message)
  (setq tStr ""); end setq
  (if Spaces
    (setq pSps(list "\r"))
    (setq pSps(list " " "\r"))
    ); end if
   (while
      (and
        (not(member lChr pSps))
	(/= 3(car grLst))
        ); end and
      (if
        (setq grLst(grread nil 4 2))
        (progn
         (cond
          ((= 3(car grLst))
           (setq filPt(cadr grLst)
                 selSet(ssget filPt)
                 ); end setq
           (if selSet
                (setq outVal
                (list(ssname selSet 0)filPt))
             ); end if
           ); end condition #1
	  ((or
	     (equal '(2 13) grLst)
	     (equal 25(car grLst))
	     ); end or
	    (setq lChr "\r"
		  outVal tStr); end setq
	   ); end condition #2
	  ((and
	     (equal '(2 8) grLst)
	     (< 0(strlen tStr))
	     ); end and
	   (setq tStr(substr tStr 1(1-(strlen tStr))))
	   (princ(strcat(chr 8)(chr 32)(chr 8)))
	   ); end condition #3
          ((and
	     (= 2(car grLst))
	     (<= 32(cadr grLst)126)
	     ); end and
           (setq lChr(chr(cadr grLst)))
           (if(not(member lChr pSps))
                 (progn
                 (setq tStr(strcat tStr lChr)
                       outVal tStr); end setq
             (princ lChr)
           ); end progn
          ); end if
         ); end condition #4
        ); end cond
       ); end progn
      ); end if
     ); end while
    outVal
 ); end of Entsel_or_Text
  

  (while(not okFlg)
    (princ(strcat "\nCurrent material = " dwrite:material))
    (setq plObj(Entsel_or_Text T "\nSelect polyline or [Material]: "))
    (cond
      ((and
	  (= 'LIST(type plObj))
	  (= "LWPOLYLINE"(cdr(assoc 0(entget(car plObj)))))
	 ); end and
       (setq plObj(car plObj)
	     okFlg T); end setq
       ); end condition #1
      ((= 'LIST(type plObj))
       (princ "\nThis isn't LwPolyline! ")
       ); end condition #2
      ((and
	 (= 'STR(type plObj))
	 (member(strcase plObj) '("M" "_M" "MATERIAL" "_MATERIAL"))
	 
	 ); end and
       (textscr)
       (princ "\n====== MATERIAL LIST ======")
       (foreach m mLst
	 (princ(strcat "\n[" (itoa(car m)) "] - "(cdr m)))
	 ); end foreach
       (princ "\n===========================")
       (setq mNum(getint "\nSelect material from list: "))
       (if(and mNum(setq cMat(assoc mNum mLst)))
	 (progn
	   (setq dwrite:material(cdr cMat))
	   (graphscr)
	   ); end progn
	 (princ "\nCan't find material with this number! ")
	 ); end if
       ); end condition #3
      ((null plObj)
        (princ "\nEmpty selection! ")
       ); end condition #4
      (T
       (princ "\nInvalid keyword option! ")
       ); end condition #5
      ); end cond
    ); end while
  (while(not stBl)
    (setq stBl(Entsel_or_Text T "\nSelect 'Begin' block or type name: "))
    (cond
      ((and
	 (= 'LIST(type stBl))
	 (= "INSERT"(cdr(assoc 0(entget(car stBl)))))
	); end and
        (setq stBl(cdr(assoc 2(entget(car stBl)))))
       ); end condition #1
      ((= 'LIST(type stBl))
        (princ "\nThis isn't block! ")
        (setq stBl nil)
       ); end condition #2
      ((null stBl)
       (princ "\nEmpty input! ")
       ); end condition #3
      ); end cond
    ); end while
 (while(not enBl)
    (setq enBl(Entsel_or_Text T "\nSelect 'End' block or type name: "))
    (cond
      ((and
	 (= 'LIST(type enBl))
	 (= "INSERT"(cdr(assoc 0(entget(car enBl)))))
	); end and
        (setq enBl(cdr(assoc 2(entget(car enBl)))))
       ); end condition #1
      ((= 'LIST(type enBl))
        (princ "\nThis isn't block! ")
        (setq enBl nil)
       ); end condition #2
      ((null enBl)
       (princ "\nEmpty input! ")
       ); end condition #3
      ); end cond
    ); end while
  (setq datLst(list(cons 1 stBl)(cons 2 enBl)(cons 3 dwrite:material))
	plObj(vlax-ename->vla-object plObj)
	hyObj(vla-get-Hyperlinks plObj)
	); end setq
  (if(vlax-ldata-get plObj "PipeData")
      (progn
	(initget "Yes No")
	(setq cAns(getkword "\nPipe data already exists. Overwrite? [Yes/No]: "))
	(if(= "Yes" cAns)
	  (progn
	   (vlax-ldata-delete plObj "PipeData")
	   (vlax-ldata-put plObj "PipeData" datLst)
	   (vla-Delete(vla-Item hyObj 0))
	   (vla-Add hyObj "Has Pipe Data" (strcat "Material: " dwrite:material))
	   (princ "\n<<< Data successfuly added >>> ")
	   );end progn
	  ); end if
	); end progn
      (progn
       (vlax-ldata-put plObj "PipeData" datLst)
       (vla-Add hyObj "Has Pipe Data" (strcat "Material: " dwrite:material))
       (princ "\n<<< Data successfuly added >>> ")
       ); end progn
      ); end if	
  (princ)
 ); c:dwrite




(defun c:dcollect(/ plSet oLst cDat fName cAns exApp wbCol cDoc)
  (if(setq plSet(ssget "_X" '((0 . "LWPOLYLINE"))))
    (progn
      (foreach pl (mapcar 'vlax-ename->vla-object
                     (vl-remove-if 'listp
                       (mapcar 'cadr(ssnamex plSet))))
	(if(setq cDat(vlax-ldata-get pl "PipeData"))
	  (progn
	    (setq oLst(cons
			(list
			     (vla-get-ConstantWidth pl)
			     (vla-get-Layer pl)
			     (cdr(assoc 1 cDat))
			     (cdr(assoc 2 cDat))
			     (cdr(assoc 3 cDat))
			     (vlax-curve-GetDistAtParam pl
			       (vlax-curve-GetEndParam pl))
			    ); end list
		      oLst); end cons
		  ); end setq
	    ); end progn
	  ); end if
	); end foreach
      (if oLst
	(progn
	  (setq fDescr(open
			(setq fName(strcat(vl-filename-directory(getvar "SAVENAME"))
			  "\\"(vl-filename-base(getvar "DWGNAME")) ".csv")) "w"))
	  (write-line "Diameter;Layer;From;To;Material;Length" fDescr)
	  (foreach itm (reverse oLst)
	      (write-line (strcat(rtos(* 1000.0(nth 0 itm)))
				 ";" (nth 1 itm)
				 ";" (nth 2 itm)
				 ";" (nth 3 itm)
				 ";" (nth 4 itm)
				 ";" (rtos(nth 5 itm)))
		fDescr)
	    ); end foreach
	  (close fDescr)
	  (princ(strcat "\nCSV file location: " fName ))
	  (initget "Yes No")
	  (setq cAns(getkword "\nOpen file [Yes/No]: "))
	  (if(= cAns "Yes")
	    (if(setq exApp(vlax-get-or-create-object "Excel.Application"))
	      (progn
		(vlax-put-property exApp 'Visible :vlax-true)
	        (setq wbCol(vlax-get-property exApp 'Workbooks)
		      cDoc(vlax-invoke-method wbCol 'Open fName))
		(vlax-release-object cDoc)
		(vlax-release-object wbCol)
		(vlax-release-object exApp)
		); end progn
	      ); end if
	    ); end if
	  ); end progn
	(princ "\nNo data found! ")
	); end if
      ); end progn
    ); end if
  (princ)
  ); end of c:dcollect

(vl-load-com)

[feargt]

Hallo ASMI,

That's brilliant, have been testing it out this morning

I have only 2 comments of note so far

1. There will be cases where there are more than 1 pipe (polyline) on the same layer running from the same start block to the same End Block which may also have the same lenght. The question is how best to differentiate the pipes? Would a separate Pipe ID for each entry work best here?
I was thinking maybe something similar to the Material List as in a layer list to begin with

Layer 1 "01001"
Layer 2 "02002"

then for every pipe selected on layer 1, the first pipe gets the ID 01001, the second pipe gets 01002, the third gets 01003 and so on for the different layers

This is merely a suggestion as I do not know what would be the easiest workaround for this issue. With your experience you most likely would have a better idea or solution for this.



2. This point is not issue with the program, just a request more so that may make life easier for using the lisp file. In the hyperlink it would great if one could read all the data too, ie Layer and lenght and pipe ID too?
at the moment it is displaying

Material: N/A

I have changed this that it reads your original version also

stblk-->enblk _ Material: N/A

I have tried but without success to also include

stblk-->enblk _ Material: N/A _ Layer: XY _ Length: 10.50 Pipe ID: 0101


I am very grateful for what you have provided me with to-date. As u said in your last reply it will also need a way to remove the Hyperlinks and the data that is attached via the lisp file.

There is also no immediate rush on this, whenever you get round to it would be soon enough, I appreciate that you will have other priorities etc.

Regards

Feargt

[ASMI]

1. There will be cases where there are more than 1 pipe (polyline) on the same layer running from the same start block to the same End Block which may also have the same lenght. The question is how best to differentiate the pipes? Would a separate Pipe ID for each entry work best here?
I was thinking maybe something similar to the Material List as in a layer list to begin with

Layer 1 "01001"
Layer 2 "02002"

then for every pipe selected on layer 1, the first pipe gets the ID 01001, the second pipe gets 01002, the third gets 01003 and so on for the different layers

This is merely a suggestion as I do not know what would be the easiest workaround for this issue. With your experience you most likely would have a better idea or solution for this.

There is ObjectID property whish is unique to each entity. The truth is 10 characters, you may seem a lot. If it does not fit, you can think of something else.

2. This point is not issue with the program, just a request more so that may make life easier for using the lisp file. In the hyperlink it would great if one could read all the data too, ie Layer and lenght and pipe ID too?
at the moment it is displaying

Material: N/A

I have changed this that it reads your original version also

stblk-->enblk _ Material: N/A

I have tried but without success to also include

stblk-->enblk _ Material: N/A _ Layer: XY _ Length: 10.50 Pipe ID: 0101

Unfortunately Hyperlink hint has limited the number of signs and trim it. So I just left the ID, Material and Lenght. But all the properties can now look at using DDATA command.

I am very grateful for what you have provided me with to-date. As u said in your last reply it will also need a way to remove the Hyperlinks and the data that is attached via the lisp file.

Use DDELETE command to remove data and hyprlinks.

In truth it was too early to use because there are many disadvantages. For example if the line on locked layers DWRITE and DDELETE will generate an error. Also, the command needed to update the hyperlinks possible polylines changes.