Jump to content

LISP to show MTEXT label next to Polyline

andy_06

By andy_06
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

andy_06 Enthusiast

andy_06

Posted
Posted

Hi,

 

I am looking for some help to see if it is possible to write a LISP routine that looks at each node on the attached drawing and return the diameter and length inbetween in a CSV file. I have also attached a CSV that matches the data on the example drawing to show how I would like it to look.

 

Thank you in advance.

TEST.csv TEST.dwg

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

This will get you the nodes and the line lengths into a list, which can be taken further to export to a CSV. Each polyline data is saved as a separate item in the final list. Trying to think f the best way to grab the text and ignore other texts that might be near the line.

 

One question about the texts, could I assume that all the diameter texts are drawn on the same layer as the polylines, as in the example. Could there be other text on that layer too? If it is only that text them I am sure there is a LISP out there to refer to that links the text to the nearest line in a selection.

 

This can be made quicker if all the nodes are on the same layer or have the same block name by using a line "select a node block", then use that information to filter the selection of all the node blocks

 

  

(defun c:Polylineendblocks ( / MyNodes PLss BLss PLEnt BLEnt EndA EndB acount BLCount )
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-attribute-value-from-a-block/td-p/10763258
  (defun GetAtt (Ent AttName / Att) ; Get attribute from a block
    (foreach Att (vlax-invoke (vlax-ename->vla-object Ent) 'GetAttributes ) ;_ end of vlax-invoke
      (if (= (strcase (vla-get-TagString Att)) AttName)
        (setq tmpList (vla-get-TextString Att))
      ) ; end if
    ) ; end for each
    tmpList ; return attribute value
  ) ; end defun

  (setq MyNodes (list))                       ; blank list for the results
  (setq PLss (ssget '((0 . "LWPOLYLINE"))))   ; Select polylines (see below to select all polylines)
  (setq BLss (ssget "_X" '((0 . "INSERT"))))  ; select all blocks (remove "_X" for user selection)
;;Get node definitions
  (setq acount 0)                             ; a counter
  (while (< acount (sslength PLss))           ; Loop for number of selected polylines
    (setq LineData (list "EndARef" "EndBRef" "Length" "Diam" "Tag")) ; blank list for line results
    (setq PLEnt (ssname PLss acount))         ; Get each individual polyline
    (setq EndA (cdr (assoc 10 (entget PLEnt))))  ; Get polyline start point
    (setq EndB (cdr (assoc 10 (reverse (entget PLEnt))))) ; get polyline end point
    (if (= (length EndA) 2)                      ; Set EndA coordinates to a standard formaat for later
      (setq EndA (append EndA '(0)))
      (setq EndA (mapcar '* '(1 1 0) EndA))
    )
    (if (= (length EndB) 2)                      ; same for EndB
      (setq EndB (append EndB '(0)))
      (setq EndB (mapcar '* '(1 1 0) EndB))
    )
    (setq BLCount 0)
    (while (< BLCount (sslength BLss))          ; Loop through all the selected blocks, and compare their insertion points to EndA & EndB
      (setq BLEnt (ssname BLss BLcount))
      (setq BLCoord (mapcar '* '(1 1 0) (cdr (assoc 10 (entget BLEnt))) )) ; set to 0 Z
      (if (equal EndA (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; compare the 2 include fuzz factor
        (progn
          (setq LineData (subst (GetAtt BLEnt "1") (nth 0 LineData) LineData))   ; set End A if found in results
          (vl-cmdf "_.area" "_e" PLEnt)
          (setq LineData (subst (getvar "perimeter") (nth 2 LineData) LineData)) ; set Length in results
        ) ; end progn
      ) ; end if
      (if (equal EndB (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; include fuzz factor
        (setq LineData (subst (GetAtt BLEnt "1") (nth 1 LineData) LineData))     ; set End B in results
      ) ; end if
      (setq BLCount (+ BLCount 1))
    )

    (setq MyNodes (append MyNodes (list LineData)))         ; Append reults to end results

    (setq acount (+ acount 1))
  ) ; end while

  MyNodes                                                  ; return MyNodes list
) ;end defun

 

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

This isn't quite working right, but will look tomorrow, can be improved with information about layer control as above

  

(defun textalongline ( MyEnt / o MyEntA MySS MyResult OffsetDist) ;; Draws an offset line, selects all text in that, needs more filters
  ;;https://forums.autodesk.com/t5/vba/select-everything-within-a-closed-polyline/td-p/350342
  (defun massoc (key alist / x nlist)
    (foreach x alist
      (if (eq key (car x))
        (setq nlist (cons (cdr x) nlist))
      )
    )
    (reverse nlist)
  )

  (setq OffsetDist 2)
  (setq o (vlax-ename->vla-object MyEnt))
  (vla-offset o OffsetDist)
  (setq MyEntA (entlast))
  (vla-offset o (- OffsetDist))
  (setvar "peditaccept" 1)
  (command "pedit" "m" (entlast) MyEntA "" "j" "j" "b" "4" "C" "")
  (setq MySS (ssget "cp" (massoc 10 (entget (entlast))) '((0 . "*TEXT")) ) )
  (setq MyResult (assoc 1 (entget (ssname MySS 0))))
  (entdel (entlast))
  MyResult
)



(defun c:Polylineendblocks ( / MyNodes PLss BLss PLEnt BLEnt EndA EndB acount BLCount )
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-attribute-value-from-a-block/td-p/10763258
  (defun GetAtt (Ent AttName / Att) ; Get attribute from a block
    (foreach Att (vlax-invoke (vlax-ename->vla-object Ent) 'GetAttributes ) ;_ end of vlax-invoke
      (if (= (strcase (vla-get-TagString Att)) AttName)
        (setq tmpList (vla-get-TextString Att))
      ) ; end if
    ) ; end for each
    tmpList ; return attribute value
  ) ; end defun

  (setq MyNodes (list))                       ; blank list for the results
  (setq PLss (ssget '((0 . "LWPOLYLINE"))))   ; Select polylines (see below to select all polylines)
  (setq BLss (ssget "_X" '((0 . "INSERT"))))  ; select all blocks (remove "_X" for user selection)
;;Get node definitions
  (setq acount 0)                             ; a counter
  (while (< acount (sslength PLss))           ; Loop for number of selected polylines
    (setq LineData (list "EndARef" "EndBRef" "Length" "Diam" "Tag")) ; blank list for line results
    (setq PLEnt (ssname PLss acount))         ; Get each individual polyline
    (setq EndA (cdr (assoc 10 (entget PLEnt))))  ; Get polyline start point
    (setq EndB (cdr (assoc 10 (reverse (entget PLEnt))))) ; get polyline end point
    (if (= (length EndA) 2)                      ; Set EndA coordinates to a standard formaat for later
      (setq EndA (append EndA '(0)))
      (setq EndA (mapcar '* '(1 1 0) EndA))
    )
    (if (= (length EndB) 2)                      ; same for EndB
      (setq EndB (append EndB '(0)))
      (setq EndB (mapcar '* '(1 1 0) EndB))
    )
    (setq BLCount 0)
    (while (< BLCount (sslength BLss))          ; Loop through all the selected blocks, and compare their insertion points to EndA & EndB
      (setq BLEnt (ssname BLss BLcount))
      (setq BLCoord (mapcar '* '(1 1 0) (cdr (assoc 10 (entget BLEnt))) )) ; set to 0 Z
      (if (equal EndA (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; compare the 2 include fuzz factor
        (progn
          (setq LineData (subst (GetAtt BLEnt "1") (nth 0 LineData) LineData))   ; set End A if found in results
          (vl-cmdf "_.area" "_e" PLEnt)
          (setq LineData (subst (getvar "perimeter") (nth 2 LineData) LineData)) ; set Length in results
          (setq LineData (subst (textalongline PLEnt) (nth 3 LineData) LineData)) ; set Length in results
        ) ; end progn
      ) ; end if
      (if (equal EndB (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; include fuzz factor
        (setq LineData (subst (GetAtt BLEnt "1") (nth 1 LineData) LineData))     ; set End B in results
      ) ; end if
      (setq BLCount (+ BLCount 1))
    )

    (setq MyNodes (append MyNodes (list LineData)))         ; Append reults to end results

    (setq acount (+ acount 1))
  ) ; end while

  MyNodes                                                  ; return MyNodes list
) ;end defun

 

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

Try this, I am happier with it, 3 LISPs, textalongline, WriteCSV are functions used by polylineendblocks

 

Command: polylineendblocks, you might want to shorten that to make it more snappy

 

Layers: This selects items on layers containing 'water' (0waternodes for example, though you might also later have 5waternodes, it should also pick that up)

Diameter Text Selection: Selects text within '2' of the polyline, this can be increased changing OffsetDist to suit - but don't make it too big else it could grab other text

'Tag' in the results is taken from your example CSV, not sure what you want in there, it is in as a marker really

 

  

(defun textalongline ( MyEnt / o MyEntA MySS MyResult OffsetDist) ;; Draws an offset line, selects all text in that, needs more filters
  ;;https://forums.autodesk.com/t5/vba/select-everything-within-a-closed-polyline/td-p/350342
  (defun massoc (key alist / x nlist)
    (foreach x alist
      (if (eq key (car x))
        (setq nlist (cons (cdr x) nlist))
      )
    )
    (reverse nlist)
  )

  (setq OffsetDist 2)
  (setq o (vlax-ename->vla-object MyEnt))
  (vla-offset o OffsetDist)
  (setq MyEntA (entlast))
  (vla-offset o (- OffsetDist))
  (setvar "peditaccept" 1)
  (command "pedit" "m" (entlast) MyEntA "" "j" "j" "b" "4" "C" "")
  (setq MySS (ssget "cp" (massoc 10 (entget (entlast))) '((0 . "*TEXT")(8 . "*water*") ) ) )
;;  (setq MyResult (assoc 1 (entget (ssname MySS 0))))
  (entdel (entlast))

(setq MyResult (vla-get-TextString(vlax-ename->vla-object (ssname MySS 0) )))

  MyResult
)

(defun WriteCSV ( MyList / f )
  (defun LM:lst->str ( lst del ) ; Lee Mac ; Change lis tto comma seperated string
    (if (cdr lst)
      (strcat (car lst) del (LM:lst->str (cdr lst) del))
      (car lst)
    ) ; end if
  ) ; end defun
  (if (setq f (getfiled "Select File" "" "csv" 1)) ; select output file
    (progn
      (setq f (open f "w"))                        ; Open output file
        (foreach x MyList                          ; Loop through data list
          (write-line (LM:lst->str x ", ") f)      ; write line to output file
        ) ; end foreach
      (close f)                                    ; Close oputput file
    ) ; end progn
  ) ; end if
  (princ)
) ; end defun


(defun c:Polylineendblocks ( / MyNodes PLss BLss PLEnt BLEnt EndA EndB acount BLCount )
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-attribute-value-from-a-block/td-p/10763258
  (defun GetAtt (Ent AttName / Att) ; Get attribute from a block
    (foreach Att (vlax-invoke (vlax-ename->vla-object Ent) 'GetAttributes ) ;_ end of vlax-invoke
      (if (= (strcase (vla-get-TagString Att)) AttName)
        (setq tmpList (vla-get-TextString Att))
      ) ; end if
    ) ; end for each
    tmpList ; return attribute value
  ) ; end defun

  (setq MyNodes (list))                       ; blank list for the results
  (setq PLss (ssget '((0 . "LWPOLYLINE") (8 . "*water*") )))   ; Select polylines (see below to select all polylines)
  (setq BLss (ssget "_X" '((0 . "INSERT")(8 . "*water*")(2 . "GNW") )))  ; select all blocks (remove "_X" for user selection)
;;Get node definitions
  (setq acount 0)                             ; a counter
  (while (< acount (sslength PLss))           ; Loop for number of selected polylines
    (setq LineData (list "EndARef" "EndBRef" "Length" "Diam" "Tag")) ; blank list for line results
    (setq PLEnt (ssname PLss acount))         ; Get each individual polyline
    (setq EndA (cdr (assoc 10 (entget PLEnt))))  ; Get polyline start point
    (setq EndB (cdr (assoc 10 (reverse (entget PLEnt))))) ; get polyline end point
    (if (= (length EndA) 2)                      ; Set EndA coordinates to a standard formaat for later
      (setq EndA (append EndA '(0)))
      (setq EndA (mapcar '* '(1 1 0) EndA))
    )
    (if (= (length EndB) 2)                      ; same for EndB
      (setq EndB (append EndB '(0)))
      (setq EndB (mapcar '* '(1 1 0) EndB))
    )
    (setq BLCount 0)
    (while (< BLCount (sslength BLss))          ; Loop through selected blocks, compare their insertion points to End
      (setq BLEnt (ssname BLss BLcount))
      (setq BLCoord (mapcar '* '(1 1 0) (cdr (assoc 10 (entget BLEnt))) )) ; set to 0 Z
      (if (equal EndA (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; compare the 2 include fuzz factor
        (progn
          (setq LineData (subst (GetAtt BLEnt "1") (nth 0 LineData) LineData))   ; set End A if found in results
          (vl-cmdf "_.area" "_e" PLEnt)
          (setq LineData (subst (rtos (getvar "perimeter")) (nth 2 LineData) LineData)) ; set Length in results
          (setq LineData (subst (textalongline PLEnt) (nth 3 LineData) LineData)) ; set Length in results
        ) ; end progn
      ) ; end if
      (if (equal EndB (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; include fuzz factor
        (setq LineData (subst (GetAtt BLEnt "1") (nth 1 LineData) LineData))     ; set End B in results
      ) ; end if
      (setq BLCount (+ BLCount 1))
    )

    (setq MyNodes (append MyNodes (list LineData)))         ; Append reults to end results

    (setq acount (+ acount 1))
  ) ; end while

  (WriteCSV MyNodes)                                        ; Function to create CSV file
)

 

Link to comment
Share on other sites
andy_06 Enthusiast

andy_06

Posted
  • Author
Posted (edited)
1 hour ago, Steven P said:

Try this, I am happier with it, 3 LISPs, textalongline, WriteCSV are functions used by polylineendblocks

 

Command: polylineendblocks, you might want to shorten that to make it more snappy

 

Layers: This selects items on layers containing 'water' (0waternodes for example, though you might also later have 5waternodes, it should also pick that up)

Diameter Text Selection: Selects text within '2' of the polyline, this can be increased changing OffsetDist to suit - but don't make it too big else it could grab other text

'Tag' in the results is taken from your example CSV, not sure what you want in there, it is in as a marker really

 

  

(defun textalongline ( MyEnt / o MyEntA MySS MyResult OffsetDist) ;; Draws an offset line, selects all text in that, needs more filters
  ;;https://forums.autodesk.com/t5/vba/select-everything-within-a-closed-polyline/td-p/350342
  (defun massoc (key alist / x nlist)
    (foreach x alist
      (if (eq key (car x))
        (setq nlist (cons (cdr x) nlist))
      )
    )
    (reverse nlist)
  )

  (setq OffsetDist 2)
  (setq o (vlax-ename->vla-object MyEnt))
  (vla-offset o OffsetDist)
  (setq MyEntA (entlast))
  (vla-offset o (- OffsetDist))
  (setvar "peditaccept" 1)
  (command "pedit" "m" (entlast) MyEntA "" "j" "j" "b" "4" "C" "")
  (setq MySS (ssget "cp" (massoc 10 (entget (entlast))) '((0 . "*TEXT")(8 . "*water*") ) ) )
;;  (setq MyResult (assoc 1 (entget (ssname MySS 0))))
  (entdel (entlast))

(setq MyResult (vla-get-TextString(vlax-ename->vla-object (ssname MySS 0) )))

  MyResult
)

(defun WriteCSV ( MyList / f )
  (defun LM:lst->str ( lst del ) ; Lee Mac ; Change lis tto comma seperated string
    (if (cdr lst)
      (strcat (car lst) del (LM:lst->str (cdr lst) del))
      (car lst)
    ) ; end if
  ) ; end defun
  (if (setq f (getfiled "Select File" "" "csv" 1)) ; select output file
    (progn
      (setq f (open f "w"))                        ; Open output file
        (foreach x MyList                          ; Loop through data list
          (write-line (LM:lst->str x ", ") f)      ; write line to output file
        ) ; end foreach
      (close f)                                    ; Close oputput file
    ) ; end progn
  ) ; end if
  (princ)
) ; end defun


(defun c:Polylineendblocks ( / MyNodes PLss BLss PLEnt BLEnt EndA EndB acount BLCount )
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-attribute-value-from-a-block/td-p/10763258
  (defun GetAtt (Ent AttName / Att) ; Get attribute from a block
    (foreach Att (vlax-invoke (vlax-ename->vla-object Ent) 'GetAttributes ) ;_ end of vlax-invoke
      (if (= (strcase (vla-get-TagString Att)) AttName)
        (setq tmpList (vla-get-TextString Att))
      ) ; end if
    ) ; end for each
    tmpList ; return attribute value
  ) ; end defun

  (setq MyNodes (list))                       ; blank list for the results
  (setq PLss (ssget '((0 . "LWPOLYLINE") (8 . "*water*") )))   ; Select polylines (see below to select all polylines)
  (setq BLss (ssget "_X" '((0 . "INSERT")(8 . "*water*")(2 . "GNW") )))  ; select all blocks (remove "_X" for user selection)
;;Get node definitions
  (setq acount 0)                             ; a counter
  (while (< acount (sslength PLss))           ; Loop for number of selected polylines
    (setq LineData (list "EndARef" "EndBRef" "Length" "Diam" "Tag")) ; blank list for line results
    (setq PLEnt (ssname PLss acount))         ; Get each individual polyline
    (setq EndA (cdr (assoc 10 (entget PLEnt))))  ; Get polyline start point
    (setq EndB (cdr (assoc 10 (reverse (entget PLEnt))))) ; get polyline end point
    (if (= (length EndA) 2)                      ; Set EndA coordinates to a standard formaat for later
      (setq EndA (append EndA '(0)))
      (setq EndA (mapcar '* '(1 1 0) EndA))
    )
    (if (= (length EndB) 2)                      ; same for EndB
      (setq EndB (append EndB '(0)))
      (setq EndB (mapcar '* '(1 1 0) EndB))
    )
    (setq BLCount 0)
    (while (< BLCount (sslength BLss))          ; Loop through selected blocks, compare their insertion points to End
      (setq BLEnt (ssname BLss BLcount))
      (setq BLCoord (mapcar '* '(1 1 0) (cdr (assoc 10 (entget BLEnt))) )) ; set to 0 Z
      (if (equal EndA (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; compare the 2 include fuzz factor
        (progn
          (setq LineData (subst (GetAtt BLEnt "1") (nth 0 LineData) LineData))   ; set End A if found in results
          (vl-cmdf "_.area" "_e" PLEnt)
          (setq LineData (subst (rtos (getvar "perimeter")) (nth 2 LineData) LineData)) ; set Length in results
          (setq LineData (subst (textalongline PLEnt) (nth 3 LineData) LineData)) ; set Length in results
        ) ; end progn
      ) ; end if
      (if (equal EndB (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; include fuzz factor
        (setq LineData (subst (GetAtt BLEnt "1") (nth 1 LineData) LineData))     ; set End B in results
      ) ; end if
      (setq BLCount (+ BLCount 1))
    )

    (setq MyNodes (append MyNodes (list LineData)))         ; Append reults to end results

    (setq acount (+ acount 1))
  ) ; end while

  (WriteCSV MyNodes)                                        ; Function to create CSV file
)

 

 

Hi Steven,

 

Wow that is great thank you! There are only a couple of tweaks:

Can row 1 have the headers as per my test CSV (i.e. Node, Node, Length, Diam, Tag) - no problem if not.

Can the Diam data just show the numbers at the start without the mm PE100 (i.e. 63, 90, 125) - no problem if not.

Then the tag column only needs the header so the remaining rows can be left blank, this is just so that it matches the data in my own spreadsheet that I transfer over to.

Can the CSV file automatically save to the same folder as the CAD drawing?

Finally, is it possible for the pipe lengths to be a whole number? (this can be rounded to the nearest whole number).

 

Thank you in advance, this will really help me.

 

Edited by andy_06
Added 1 more request
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted (edited)

Yes, that is all OK - will look at it shortly,.

 

Quick changes you can do (find and replace) - first 2 to sort out the CSV data columns

  

(setq MyNodes (list))

Change to:

(setq MyNodes (list '("Node" "Node" "Length" "Diam" "Tag") )) ;; CSV Header Data

 

and

 

(edited this one for a correction)

  

(setq LineData (list "EndARef" "EndBRef" "Length" "Diam" "Tag")) ; blank list for line results

Change to

(setq LineData (list "EndARef" "EndBRef" "Length" "Diam")) ; blank list for line results ;; Removes the text 'tag'

 

 

Add this in somewhere from Lee Mac, probably after polylineendblocks defun line ((defun c:Polylineendblocks ( / MyNodes PLss BLss PLEnt BLEnt EndA EndB acount BLCount ))

  

(defun LM:round ( n ) ;;http://www.lee-mac.com/round.html
    (fix (+ n (if (minusp n) -0.5 0.5)))
)

 

and copy and replace:

  

(setq LineData (subst (rtos (getvar "perimeter")) (nth 2 LineData) LineData)) ; set Length in results

change to


(setq LineData (subst (rtos (LM:round (getvar "perimeter")) ) (nth 2 LineData) LineData)) ; set Length in results

 

should sort the rounding. If you want to round up to the nearest then the link to Lee Macs website has other rounding functions you could use instead.

 

Taking out the PE... is simple but needs a few more lines than a simple find and replace

Edited by Steven P
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

Putting that together and only a value for the diameter:

  

(defun textalongline ( MyEnt / o MyEntA MySS MyResult OffsetDist) ;; Draws an offset line, selects all text in that, needs more filters
  ;;https://forums.autodesk.com/t5/vba/select-everything-within-a-closed-polyline/td-p/350342
  (defun massoc (key alist / x nlist)
    (foreach x alist
      (if (eq key (car x))
        (setq nlist (cons (cdr x) nlist))
      )
    )
    (reverse nlist)
  )

  (setq OffsetDist 2)
  (setq o (vlax-ename->vla-object MyEnt))
  (vla-offset o OffsetDist)
  (setq MyEntA (entlast))
  (vla-offset o (- OffsetDist))
  (setvar "peditaccept" 1)
  (command "pedit" "m" (entlast) MyEntA "" "j" "j" "b" "4" "C" "")
  (setq MySS (ssget "cp" (massoc 10 (entget (entlast))) '((0 . "*TEXT")(8 . "*water*") ) ) )
;;  (setq MyResult (assoc 1 (entget (ssname MySS 0))))
  (entdel (entlast))

(setq MyResult (vla-get-TextString(vlax-ename->vla-object (ssname MySS 0) )))

  MyResult
)

(defun WriteCSV ( MyList / f )
  (defun LM:lst->str ( lst del ) ; Lee Mac ; Change lis tto comma seperated string
    (if (cdr lst)
      (strcat (car lst) del (LM:lst->str (cdr lst) del))
      (car lst)
    ) ; end if
  ) ; end defun
  (if (setq f (getfiled "Select File" "" "csv" 1)) ; select output file
    (progn
      (setq f (open f "w"))                        ; Open output file
        (foreach x MyList                          ; Loop through data list
          (write-line (LM:lst->str x ", ") f)      ; write line to output file
        ) ; end foreach
      (close f)                                    ; Close oputput file
    ) ; end progn
  ) ; end if
  (princ)
) ; end defun


(defun c:Polylineendblocks ( / MyNodes PLss BLss PLEnt BLEnt EndA EndB acount BLCount )
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-attribute-value-from-a-block/td-p/10763258
  (defun GetAtt (Ent AttName / Att) ; Get attribute from a block
    (foreach Att (vlax-invoke (vlax-ename->vla-object Ent) 'GetAttributes ) ;_ end of vlax-invoke
      (if (= (strcase (vla-get-TagString Att)) AttName)
        (setq tmpList (vla-get-TextString Att))
      ) ; end if
    ) ; end for each
    tmpList ; return attribute value
  ) ; end defun

  (defun LM:round ( n ) ;;http://www.lee-mac.com/round.html
    (fix (+ n (if (minusp n) -0.5 0.5)))
  ) ; end defun

  (defun LM:str->lst ( str del / pos ) ;;http://lee-mac.com/stringtolist.html
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
  )

  (setq MyNodes (list '("Node" "Node" "Length" "Diam" "Tag") ))    ; CSV Header Data
  (setq PLss (ssget '((0 . "LWPOLYLINE") (8 . "*water*") )))   ; Select polylines (see below to select all polylines)
  (setq BLss (ssget "_X" '((0 . "INSERT")(8 . "*water*")(2 . "GNW") )))  ; select all blocks (remove "_X" for user selection)
;;Get node definitions
  (setq acount 0)                             ; a counter
  (while (< acount (sslength PLss))           ; Loop for number of selected polylines
    (setq LineData (list "EndARef" "EndBRef" "Length" "Diam")) ; blank list for line results
    (setq PLEnt (ssname PLss acount))         ; Get each individual polyline
    (setq EndA (cdr (assoc 10 (entget PLEnt))))  ; Get polyline start point
    (setq EndB (cdr (assoc 10 (reverse (entget PLEnt))))) ; get polyline end point
    (if (= (length EndA) 2)                   ; Set EndA coordinates to a standard formaat for later
      (setq EndA (append EndA '(0)))
      (setq EndA (mapcar '* '(1 1 0) EndA))
    )
    (if (= (length EndB) 2)                   ; same for EndB
      (setq EndB (append EndB '(0)))
      (setq EndB (mapcar '* '(1 1 0) EndB))
    )
    (setq BLCount 0)
    (while (< BLCount (sslength BLss))         ; Loop through selected blocks, compare their insertion points to End
      (setq BLEnt (ssname BLss BLcount))
      (setq BLCoord (mapcar '* '(1 1 0) (cdr (assoc 10 (entget BLEnt))) )) ; set to 0 Z
      (if (equal EndA (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; compare the 2 include fuzz factor
        (progn
          (setq LineData (subst (GetAtt BLEnt "1") (nth 0 LineData) LineData))   ; End A
          (vl-cmdf "_.area" "_e" PLEnt)
          (setq LineData (subst (rtos (LM:Round (getvar "perimeter")) ) (nth 2 LineData) LineData)) ; Length
          (setq LineData (subst (nth 0 (LM:str->lst (textalongline PLEnt) "mm")) (nth 3 LineData) LineData)) ; diameter
        ) ; end progn
      ) ; end if
      (if (equal EndB (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; include fuzz factor
        (setq LineData (subst (GetAtt BLEnt "1") (nth 1 LineData) LineData))     ; End B
      ) ; end if
      (setq BLCount (+ BLCount 1))
    )

    (setq MyNodes (append MyNodes (list LineData)))         ; Append reults to end results

    (setq acount (+ acount 1))
  ) ; end while

  (WriteCSV MyNodes)                                        ; Function to create CSV file
)

 

Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted

I might edit the above later - sort the data by the first node (1 - n), and put in saving to the drawing file path

Link to comment
Share on other sites
andy_06 Enthusiast

andy_06

Posted
  • Author
Posted (edited)

Thank you for your help, I really appreciate it.

 

When testing this on a few bigger drawings I have a few cells reading 'EndARef' and 'EndBRef' in columns A and B. Do you have an idea why this might be?

 

I have added the drawing that is bringing up these errors so that you can see.

TEST 2.dwg

Edited by andy_06
Added test drawing for reference.
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted (edited)

Yes, EndARef and EndBRef should be where it couldn't identify a node at the end of the polyline I think, it should be selecting them - let me have a look and a think. There were a couple of lines it didn't like as well, will see what they are doing too

 

 

 

 

EDIT:

Just checked what I thought. to get the node blocks assigned to the ends of each polyline there is a 'fuzz factor' - so that if they are not exactly equal it will find them anyway - I've set this at 0.01, a couple of the nodes are slightly further away from the line ends, so we can increase the fuzz factor. Depending on the minimum pipe length you -could- increase this quite a lot, I'll go 10x larger

 

Find and replace:

  

(equal EndA (cdr (assoc 10 (entget BLEnt))) 0.01 ) ; compare the 2 include fuzz factor


change to


(equal EndA (cdr (assoc 10 (entget BLEnt))) 0.1 ) ; compare the 2 include fuzz factor

 

and the same looking for (equal EndB ..... )

Edited by Steven P
  • Like 1
Link to comment
Share on other sites
andy_06 Enthusiast

andy_06

Posted
  • Author
Posted
5 minutes ago, Steven P said:

Yes, EndARef and EndBRef should be where it couldn't identify a node at the end of the polyline I think, it should be selecting them - let me have a look and a think. There were a couple of lines it didn't like as well, will see what they are doing too

Ah yes I can see now that the polylines weren't touching on the ones with an error. If you could somehow add a tolerance to this that would be great but at least I now know how to fix it.

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

"matches the data in my own spreadsheet" it is possible to export data direct to excel, so the need to miss cells can be carried out fairly easy. 

 

Steven P I thought i sent you  a copy of my Alan Excel Library.lsp or Getexcel.lsp either will show how to export or get data to and from excel, skipping the need for CSV.

  • Like 1
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted
8 hours ago, BIGAL said:

Steven P I thought i sent you  a copy of my Alan Excel Library.lsp or Getexcel.lsp either will show how to export or get data to and from excel, skipping the need for CSV.

 

Yes you did - I should really add that instead (though in this case I was concentrating more on getting the data from the drawing rather than the export)

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.

×
 Share
Go to topic listing
×
×
  • Create New...