« previous next »
Pages: [1] |   Go Down

Author Topic: WANTED: Return Eastings and Northings into a Table  (Read 2248 times)

0 Members and 1 Guest are viewing this topic.

Big G

  • Bull Frog
  • Posts: 415
WANTED: Return Eastings and Northings into a Table
« on: October 16, 2006, 10:58:27 PM »
Greetings,
Not been around here in a while...kinda midway through a world tour!! and now in Sydney cadding again  :-)

Hopefully someone will be able to point me in the right direction for this...

Centreline of a road - Pick a point on the CL, give it a label (ie RD1) return the label and Easting and Northing into a table.....continue the command until ESC.

Nice and easy haha!!

Mucho Gracias
Gordy
Logged
I thought i seen the light at the end of the tunnel. But it was just someone with a torch bringing me more work.
"You have to accept that somedays youre the pigeon and  somedays youre the statue"

42

  • Bull Frog
  • Posts: 483
Re: WANTED: Return Eastings and Northings into a Table
« Reply #1 on: October 17, 2006, 08:07:00 AM »
This should work for you. As you pick each point it writes the info to a crt file. This can then be cut and pasted as you see fit.
Code: [Select]
(defun c:os-ref ()
 (setq
    c_blp (getvar "BLIPMODE")
    c_col (getvar "CECOLOR")
    c_lay (getvar "CLAYER")
    c_cmd (getvar "CMDECHO")
    c_til (getvar "TILEMODE")
    c_osm (getvar "OSMODE")
    c_dimzin (getvar "DIMZIN")
    c_qaf (getvar "QAFLAGS")
 )
 (setvar "osmode" 37)
 (initget 4 "1 2 5 10 20 50 100 200 500 1250 2500")
 (setq dimsc (atoi (getkword "Enter drawing scale - (1 2 5 10 20 50 100 200 500 1250 2500)")))
 (if (= (tblsearch "block" "ref_pt") nil)
        (progn (entmake '((0 . "BLOCK")
                    (2 . "REF_PT")
                    (70 . 0)
                    (10 0.0 0.0 0.0)
               ))
               (entmake '((0 . "CIRCLE")
                   (67 . 0)
                   (8 . "0")
                   (10 0.0 0.0 0.0)
                   (40 . 0.75)
                   (210 0.0 0.0 1.0)
               ))
               (entmake '((0 . "LINE")
                   (67 . 0)
                   (8 . "0")
                   (10 0.0 0.0 0.0)
                   (11 0.53033 0.53033 0.0)
                   (210 0.0 0.0 1.0)
               ))
               (entmake '((0 . "LINE")
                   (67 . 0)
                   (8 . "0")
                   (10 0.0 0.0 0.0)
                   (11 -0.53033 0.53033 0.0)
                   (210 0.0 0.0 1.0)
               ))
               (entmake '((0 . "LINE")
                   (67 . 0)
                   (8 . "0")
                   (10 0.0 0.0 0.0)
                   (11 -0.53033 -0.53033 0.0)
                   (210 0.0 0.0 1.0)
               ))
               (entmake '((0 . "LINE")
                   (67 . 0)
                   (8 . "0")
                   (10 0.0 0.0 0.0)
                   (11 0.53033 -0.53033 0.0)
                   (210 0.0 0.0 1.0)
               ))
               (entmake '((0 . "ENDBLK"))
               )
         )       
 )
 (setq prefix (if (= (setq test2 (getstring 1 (strcat "Enter reference prefix (. for none)<" (if (/= prefix nil) prefix ".") "> :"))) ".") prefix test2))
 (if (/= (and (tblsearch "layer" "A0COORDS") (ssget "X" '((0 . "TEXT") (8 . "A0COORDS")))) nil)
    (progn
      (setq
        no_ent (ssget "X" '((0 . "TEXT") (8 . "A0COORDS")))
        no_ent2 (sslength no_ent)
        cnt (+ no_ent2 1)
        cnt (if (= (setq test (getint (strcat "Start numbering from? <" (rtos cnt 2 0) "> :"))) nil) cnt test)
        coord_fil (open (strcat (getvar "DWGPREFIX") (SUBSTR (GETVAR "DWGNAME") 1 (- (STRLEN (GETVAR "DWGNAME")) 3)) "crd") "a")
        pt1 (getpoint "\nPick point: ")
        x (nth 0 pt1)
        y (nth 1 pt1)
      )
    )
    (progn
      (command "layer" "m" "A0COORDS" "c" "7" "" "")
      (setq
        cnt 1
        cnt (if (= (setq test (getint (strcat "Start numbering from? <" (rtos cnt 2 0) "> :"))) nil) cnt test)
        coord_fil (open (strcat (getvar "DWGPREFIX") (SUBSTR (GETVAR "DWGNAME") 1 (- (STRLEN (GETVAR "DWGNAME")) 3)) "crd") "w")
        pt1 (getpoint "\nPick point: ")
        x (nth 0 pt1)
        y (nth 1 pt1)
      )
    )
  )
  (write-line (strcat (strcat prefix (rtos cnt 2 0)) ","(strcat (rtos (/ y 1000) 2 3) "N")","(strcat (rtos (/ x 1000) 2 3) "E")) coord_fil)
  (close coord_fil)
  (command "insert" "ref_pt" pt1 dimsc dimsc "0")
  (command "text" "m" "none" (subst (+ (* 2.1 dimsc) (cadr pt1)) (nth 1 pt1) pt1) (* dimsc 2.0) "0" (strcat prefix (rtos cnt 2 0)))
  (setq cnt (+ cnt 1))
  (setq pt1 (getpoint "\nPick point: "))
  (while (/= pt1 nil)
    (setq
      coord_fil (open (strcat (getvar "DWGPREFIX") (SUBSTR (GETVAR "DWGNAME") 1 (- (STRLEN (GETVAR "DWGNAME")) 3)) "crd") "a")
      x (nth 0 pt1)
      y (nth 1 pt1)
    )
    (write-line (strcat (strcat prefix (rtos cnt 2 0))","(strcat (rtos (/ y 1000) 2 3) "N")","(strcat (rtos (/ x 1000) 2 3) "E")) coord_fil)
    (close coord_fil)
    (command "insert" "ref_pt" pt1 dimsc dimsc "0")
    (command "text" "m" "none" (subst (+ (* 2.1 dimsc) (cadr pt1)) (nth 1 pt1) pt1) (* dimsc 2.0) "0" (strcat prefix (rtos cnt 2 0)))
    (setq cnt (+ cnt 1))
    (setq pt1 (getpoint "\nPick point: "))
  )
 (command "-layer" "thaw" c_lay "on" c_lay "")
 (setvar "CLAYER" c_lay)
 (setvar "BLIPMODE" c_blp)
 (setvar "CECOLOR" c_col)
 (setvar "CMDECHO" c_cmd)
 (setvar "TILEMODE" c_til)
 (setvar "OSMODE" c_osm)
 (setvar "DIMZIN" c_dimzin)
 (setvar "QAFLAGS" c_qaf)
)
Logged
Alastair Mallett Autodesk Certified Professional
Technical Director
Hunters South Architects

Big G

  • Bull Frog
  • Posts: 415
Re: WANTED: Return Eastings and Northings into a Table
« Reply #2 on: October 17, 2006, 07:37:14 PM »
FANTASTIC 42

Legend as usual!
Logged
I thought i seen the light at the end of the tunnel. But it was just someone with a torch bringing me more work.
"You have to accept that somedays youre the pigeon and  somedays youre the statue"
Pages: [1] |   Go Up
« previous next »