Jump to content

adding data to polyline and extracting this data to table?


feargt

Recommended Posts

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

Link to comment
Share on other sites

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • ASMI

    8

  • feargt

    5

  • The Buzzard

    4

  • Lee Mac

    3

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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  grLst)
     (< 0(strlen tStr))
     ); end and
   (setq tStr(substr tStr 1(1-(strlen tStr))))
   (princ(strcat(chr (chr 32)(chr ))
   ); 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)

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

(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  grLst)
     (< 0(strlen tStr))
     ); end and
   (setq tStr(substr tStr 1(1-(strlen tStr))))
   (princ(strcat(chr (chr 32)(chr ))
   ); 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]<Yes>: "))
(if(null cAns)(setq cAns "Yes"))
(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 "ID: "  (itoa(vla-get-ObjectID plObj))
				          "\nMaterial: " dwrite:material
				          "\nLength: " (rtos(vlax-curve-GetDistAtParam plObj
					                       (vlax-curve-GetEndParam plObj)))))
   (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 "ID: "  (itoa(vla-get-ObjectID plObj))
				      "\nMaterial: " dwrite:material
				      "\nLength: " (rtos(vlax-curve-GetDistAtParam plObj
					                   (vlax-curve-GetEndParam plObj)))))
      (princ "\n<<< Data successfuly added >>> ")
      ); end progn
     ); end if	
 (princ)
); c:dwrite




(defun c:dcollect(/ plSet oLst cDat fDescr 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-ObjectID pl)
		     (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 "Pipe ID;Diameter;Layer;From;To;Material;Length" fDescr)
  (foreach itm (reverse oLst)
          (write-line(strcat (itoa(nth 0 itm))
			 ";" (strcat(rtos(* 1000.0(nth 1 itm)))
			 ";" (nth 2 itm)
			 ";" (nth 3 itm)
			 ";" (nth 4 itm)
			 ";" (nth 5 itm)
			 ";" (rtos(nth 6 itm)))
		  ); end strcat
	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



(defun c:ddata(/ cEnt cDat cPln)
 (if(setq cEnt(entsel "\nSelect polyline to view data: "))
   (if(= "LWPOLYLINE"(cdr(assoc 0(entget(car cEnt)))))
     (if(setq cDat(vlax-ldata-get(setq cPln(vlax-ename->vla-object(car cEnt))) "PipeData"))
(alert(strcat
	"                   PIPE DATA                 \n"
	"\nPipe ID: " (itoa(vla-get-ObjectID cPln))
	"\nDiameter: " (rtos(* 1000.0(vla-get-ConstantWidth cPln)2 0))
	"\nLayer: " (vla-get-Layer cPln)
	"\nFrom: " (cdr(assoc 1 cDat))
	"\nTo: " (cdr(assoc 2 cDat))
	"\nMaterial: " (cdr(assoc 3 cDat))
	"\nLength: " (rtos(vlax-curve-GetDistAtParam cPln
		           (vlax-curve-GetEndParam cPln)))
	); end strcat
      ); end alert
(princ "\nNo data found! ")
); end if
     (princ "\nThis isn't LwPolyline! ")
     ); end if
   (princ "\nNothing selected! ")
   ); end if
 (princ)
 ); end of c:ddata



(defun c:ddelete(/ cCnt cAns plSet cDat hyCol cHyp)
 (initget 1 "All Selection")
 (setq cAns(getkword "\nWhich data to delete [All/Selection]: ")
cCnt 0)
 (if(= cAns "All")
   (setq plSet(ssget "_X" '((0 . "LWPOLYLINE"))))
   (setq plSet(ssget '((0 . "LWPOLYLINE"))))
   ); end if
 (getstring "\n*** WARNING! All data will deleted. Enter to Continue or Esc to Quite. ***")
 (if plSet
   (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
    (vlax-ldata-delete pl "PipeData")
    (setq cCnt(1+ cCnt))
    ); end progn
  ); end if
           (vlax-for hy(vla-get-Hyperlinks pl)
      (if(= "Has Pipe Data"(vla-get-URL hy))
	(vla-Delete hy)
	); end vlax-for
      ); end vlax-for
); end foreach
     (if(/= 0 cCnt)
(princ(strcat "\n<<< " (itoa cCnt) " item(s) was deleted >>> "))
(princ "\nNothing data found! ")
); end if
     ); end progn
   ); end if
 (princ)
 ); end of c:ddelete

(vl-load-com)

 

DWRITE - write data

DCOLLECT - put data to *.csv file

DDATA - view data

DDELETE - remove all or selected data

Link to comment
Share on other sites

Nice coding ASMI,

 

But I am curious. Is there a way to change existing data that has been already attached and can each piece of data be parced to a separate cell. It seems that if you wanted to change existing data on an object you would need to erase that object and start over, So I do not see much of an advantage to attaching data in this manner.

 

Excellent Work Anyway,

And Thanks For Your Posts

They Are Very Informative.

The Buzzard

Link to comment
Share on other sites

Thats great,

 

But if you had multiple pieces of data attached to the same object, How would you be able to call up a specific piece to overwrite?

Would it prompt you then for all the data that is attached?

Link to comment
Share on other sites

Ok

 

I see it now, Sorry about that. Great program!.

But still is there a way to parce the data to separate cells in the spreadsheet?

Link to comment
Share on other sites

Is there a way to change existing data that has been already attached...

 

Yes

 

...and can each piece of data be parced to a separate cell.

 

These, and so are in separate cells (in the associative list ((Tag. Data )...) )and are extracted in separate cells in the CSV file.

 

It seems that if you wanted to change existing data on an object you would need to erase that object and start over,...

 

There is no need to remove the objects are removed only the data. But you can not just delete and add data. Theoretically, you can add to polyline the British Encyclopedia, moreover, each chapter will be in his cell.

 

So I do not see much of an advantage to attaching data in this manner.

 

Can you suggest other ways? Yes, they exist. For example link to a database in Extended Data. But in this case it is better to use the Dictionary because the amount of data is low and the database does not exist.

Link to comment
Share on other sites

But still is there a way to parce the data to separate cells in the spreadsheet?

 

The data you have in a one cell?

 

But if you had multiple pieces of data attached to the same object, How would you be able to call up a specific piece to overwrite?

 

In this case, I use a single key and an associative list inside it, but you can use a lot of keys and a variety of data within them with the possibility of a separate access.

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...