nodes and distance extract

[mikek7]

Hi all,

 

Some of your collective brain power please ...

 

In AutoCAD, I have a series of numbered node points which are connected by polylines, the length of these lines (in metres) has been inserted.I need to extract this data either to a txt file or to Excel in the form of Node_1, node_2, distance.

 

So in the screengrab, the data would be ...

 

1,4,47

1,2,23

2,4,38

2,3,16

3,4,32

 

etc

 

I had an adapted routine which (sort of) worked manually in v2007, but now just gives a syntax error on loading.

 

As I have around 500 nodes, selecting them individually is just about feasible (if down right boring!)

 

can anyone suggest how I might do this in one hit or alternatively point out the error in the attached lsp file?

 

Thansk

Mike

 

ps, no, this is not student/homework!!

nodes_out.lsp

[Tharwat]

Hope this routine would meet your needs.

 

(defun c:Test (/ dir fNme pts coords)
 ; THARWAT Oct. 31.2010
 (defun *error* (msg)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
   (princ (strcat "\nError: " msg))
 )
)
 (vl-load-com)
 (setq dir "D:\\My Folder")
 (vl-mkdir dir)
 (setq fNme (open "D:/My Folder/coordinates.txt" "w"))
   (while
     (setq pts (getpoint "\n Specify point :")
       )
   (setq coords
      (write-line
             (strcat (rtos (car pts) 2)
             ","
                 (rtos (cadr pts) 2)
                 ","
            (rtos (caddr pts) 2))
         fNme)
     )
     )
   (close fNme)
 (princ)
 )

 

Tharwat

[mikek7]

Thanks - it's certainly a start, but doesn't really solve my main problem of how to tie a polyline distance to the 2 points it goes between - which is what I'm really tearing what's left of my hair out!

 

With the routine I had (adapted, I can't remember where from ), I picked the text at each end of the line followed by distance text. This wrote out to a txt file the 3 values in the correct order. Unfortunately, this won't work in the current AutoCAD version. Its also a real bind where there are large numbers of points as its really easy to make a mistake.

 

The code that has stopped working is (with apologies to who ever wrote it originally)...

 

(defun C:nod-out  (/ FILE FUNC ENTITY ENTTYP TEXTMT)
  (setq blank " ")
 (if (= FNAME NIL)
   (setq FNAME
          (getfiled
            "Select the text file for extract txt: "
            "c:/"
            "txt"
            1))
   (setq FUNC
          (getstring
            (strcat
              "[data to be stored in "
              FNAME
              "]"
              "/Change file/<press Enter or Right-click to proceed>:")))
   )
 (if (= FUNC "c")
   (setq FUNC "C"))
 (if (= FUNC "C")
   (setq FNAME
          (getfiled
            "Select the text file for extract txt: "
            "c:/"
            "txt"
            1)))
 (while (/= FNAME NIL)
   (setq ENTITY
          (car
            (entsel
              "\nPress `Esc` to exit, or select NODE.")))
   (if (/= ENTITY NIL)
     (progn
       (setq ENTTYP (cdr (assoc 0 (entget ENTITY))))
       (if (wcmatch ENTTYP "*TEXT*")
  (setq FILE (open FNAME "a"))
         (progn
           (setq TEXTMT (cdr (assoc 1 (entget ENTITY))))
           (write-line TEXTMT FILE)
           (prompt (strcat "\nLine- `" TEXTMT "` added to " FNAME))
           )
         (prompt "\nNOT A NODE POINT!")
         )
       )
     (prompt "\nNo node selected")
  (write-line blank file)
     (close FILE)
     )
   )
 )

 

Mike

[alanjt]

This should help get things started...

 

(defun c:Test (/ ss)
 (if (setq ss (ssget '((0 . "LINE,*POLYLINE"))))
   ((lambda (i / pts lst)
      (repeat i
        (mapcar (function (lambda (a b) (setq lst (cons (list a b (distance a b)) lst))))
                (setq pts (AT:GetVertices (ssname ss (setq i (1- i)))))
                (cdr pts)
        )
      )
      (mapcar 'print lst)
    )
     (sslength ss)
   )
 )
 (princ)
)

(defun AT:GetVertices (e / p l)
 ;; Return point at each vertex of curve
 ;; e - curve to evaluate (Arc, Line, *Polyline, Spline)
 ;; Alan J. Thompson, 09.30.10
 (if e
   (if (eq (setq p (vlax-curve-getEndParam e)) (fix p))
     (repeat (setq p (1+ (fix p)))
       (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
     )
     (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
   )
 )
)

 

Post an example drawing if you want further help.

[mikek7]

Thanks ... so, here's a example drawing that hopefully will explain what I'm trying to do. I've annotated it to try to make it a bit clearer. My first post in the thread also explains it.

 

Any help gratefully received!

forum.dwg

[alanjt]

thanks ... So, here's a example drawing that hopefully will explain what i'm trying to do. I've annotated it to try to make it a bit clearer. My first post in the thread also explains it.

 

Any help gratefully received!

beware: Educational stamp!

[mikek7]

no need for caution ... I'm a lecturer, not a student!!

[alanjt]

no need for caution ... I'm a lecturer, not a student!!

Irrelevant. An educational stamp can ruin other drawings - specifically production.

 

I'm not worried about doing your homework, I'm worried about someone ruining their DWG.

[Organic]

How does the educational stamp ruin other drawings? if you have open several drawings and open an educational stamp one also does it add the educational stamps to your other drawings that are also open as well?

[pBe]

for crying out loud

forum.dwg

[alanjt]

How does the educational stamp ruin other drawings? if you have open several drawings and open an educational stamp one also does it add the educational stamps to your other drawings that are also open as well?

Insert that drawing into your production drawing as a block and your production drawing becomes educational stamped.

I just think that when people post educational stamped DWGs, they should inform beforehand.

[Tharwat]

Insert that drawing into your production drawing as a block and your production drawing becomes educational stamped.

I just think that when people post educational stamped DWGs, they should inform beforehand.

 

Agree , but when you try to insert that stamped DWGs or copy and paste any element of that dwg , Cad would warn you for that thing Wouldn't it ?

 

Tharwat

[alanjt]

Agree , but when you try to insert that stamped DWGs or copy and paste any element of that dwg , Cad would warn you for that thing Wouldn't it ?

 

Tharwat

Don't know; not going to try.

[alanjt]

What I've provided gets everything except your point number system. You could use ssget crossing and polar each vertex to look for the text point number label. The problem is filtering out the distance text.

Little busy right now, but if time permits I'll play with it layer.

[Tharwat]

layer or Later.

[alanjt]

layer or Later.

Either works. I'm not picky.

[alanjt]

You'll need the subroutine I posted earlier.

 

(defun c:Test2 (/ _closest ss)
 ;; Alan J. Thompson,

 (defun _closest (pt)
   (caar
     (vl-sort textlist (function (lambda (a b) (< (distance pt (cadr a)) (distance pt (cadr b))))))
   )
 )

 (if (setq ss (ssget '((0 . "LINE,*POLYLINE,TEXT"))))
   ((lambda (i / e d textlist pts lst)
      (while (setq e (ssname ss (setq i (1+ i))))
        (cond ((eq (cdr (assoc 0 (setq d (entget e)))) "TEXT")
               (setq textlist (cons (list (cdr (assoc 1 d)) (cdr (assoc 10 d))) textlist))
              )
              ((wcmatch (cdr (assoc 0 d)) "LINE,*POLYLINE")
               (mapcar (function (lambda (a b) (setq lst (cons (list a b (distance a b)) lst))))
                       (setq pts (AT:GetVertices e))
                       (cdr pts)
               )
              )
        )
      )
;;;       (setq lst
;;;              (mapcar
;;;                (function (lambda (x)
;;;                            (reverse (cons (caddr x) (mapcar (function _closest) (cdr (reverse x)))))
;;;                          )
;;;                )
;;;                lst
;;;              )
;;;       )

      (setq lst
             (mapcar
               (function (lambda (x)
                           (strcat (_closest (car x))
                                   ","
                                   (_closest (cadr x))
                                   ","
                                   (rtos (caddr x) (getvar 'LUNITS) 0)
                           )
                         )
               )
               lst
             )
      )
      (mapcar 'print lst)
    )
     -1
   )
 )
 (princ)
)