Updating old LISP code

At my office we use this LISP program to import our survey data. It was made to work in LDD.

We seem to have it running in Civil 3D now after a little tweaking but I thought I would post it here and see if anyone had any ideas with it.

It basically works like this

EG+1 = start of line

EG+2 = continue line

EG+3 = end line

One thing I would be interested in is if anyone knows anything about making it so we can do non continuous lines. Basically so that we could do a cross section of a road. You would have something like this:

ER+1

CL+1

ER+1

Then next section

ER+2

CL+2

ER+2

And so on till the end. This would avoid having to walk up and down the road multiple times. Now I've seen this done in a program where you just use one code for each line. This looks like this

ER1 --> ER1

CL1 --> CL1

ER2 --> ER2

So it connects any points that use the same descriptor. This would be nice to have but the program costs $1000 and we would have to completely transfer our system into it.

It would be nice if there was an easier way to this since the cost of $1000 + how ever many hours to set it up isn't too attractive.

Anyways if you can think of any ideas that could help us out with this program that would be great.

Here's the code:

;2002/05/21 - SURVEY.lsp
;this routine reads an ascii file with 5 elements in the order
;of - stn-pt (integer or real), y , x , z , note (string)
;and elevation from z value
;to run this routine you must have a block named in the variable PTDWG with 3
;attributes 
(setq REVVER "2")
;rev 2003/03/19 - fix block elev to zero - fix OSNAP problem
;rev 2002/10/04 - neg elevs, check for / or space after 1 letter FC


(setvar "cmdecho" 0)
(setq SNAPSET (menucmd "M=$(getvar,OSMODE)"))
;(print SNAPSET)
(print (strcat "SURVEY ROUTINE LOADED - rev" REVVER))


(defun C:SURVEY ( / F1)
   (command "OSMODE" 0)
;    (command "OSMODE" 16384)
   (setq PTDWG "x-el")
     (setq BLKDIR "j:/lib/lisp/blocks.txt")
;    (setq BLKDIR "c:/baw/blocks.txt")
   (print BLKDIR)
 (setq  FDIR  (getstring "\nENTER PATH (ie C:\\BAW ).."))
   (print (vl-directory-files FDIR "*.asc"))
 (setq  FFILE (getstring "\nENTER FILE NAME (no extension) .."))
 (setq  FNAME (strcat FDIR "/" FFILE ".asc"))
 (setq  BLKSCALE (/ (getreal "\ENTER PLOT SCALE (1:500 = 500)") 1000))
   (command "Layer" "M" FFILE "")
 (setq  F1 (open FNAME "r"))
      (while
         (setq PDATA (read-line F1))
   ;    (print pdata)
       ;(getstring "ReadLine")
        (DO-IT)
   );end of while
 (close F1)
(command "ZOOM" "e")
(print "OK")
(command "OSMODE" SNAPSET)
);end of points

 (defun do-it ( / pnt n m L P x y)
   ;  (print "DO-IT MODULE")(print PDATA)
   (setq
           COUNTER99 1
       n 1
           m 1
           pnt nil
       pnt2 nil
           DESC nil
       L (strlen pdata)
     );end of setq

      (while (< n (+ L 2))
        (setq x (substr pdata n 1))
;         (if (or (or (= x ",") (= x "")) (or (= x "/") (= x " ")))
        (if (or (= x ",") (= x ""))
          (progn
           (setq PNT
              (append PNT
              (list (atof (substr PDATA M (- N M))))
              );end of append
           );end of setq

           (setq PNT2
               (append PNT2
                (list (substr PDATA M (- N M)))
               );end of append
            );end of setq

          (setq ATT (vl-string-right-trim " " (last PNT2)))

       (setq DESC (vl-string-right-trim "+0" ATT))
(print DESC)
       (setq DESC (vl-string-right-trim "+1" DESC))
(print DESC)
       (setq DESC (vl-string-right-trim "+2" DESC))
(print DESC)
       (setq DESC (vl-string-right-trim "+3" DESC))
(print DESC)
;        (setq DESC (vl-string-right-trim "+0" ATT))
;        (setq DESC (vl-string-right-trim "+1" DESC))
;        (setq DESC (vl-string-right-trim "+2" DESC))
;        (setq DESC (vl-string-right-trim "+3" DESC))
(print DESC)

           (if (= (substr ATT 1 1) "X")
               (setq X 1)
               (setq X 0)
           ); end of if
           (if (> (vl-string-search "NO Z" ATT) 0)
               (setq NOZ 1)
               (setq NOZ 0)
           ); end of if

          (setq PNTR (cdr PNT))
          (setq TEMP (reverse PNTR))
          (setq TEMP (cdr TEMP))
          (setq PT (cdr TEMP))

       (if (= NOZ 1)
           (setq ELEV -99)
           (setq ELEV (car TEMP))
       ); end of if

          (setq IP 
            (list (cadr temp) (caddr temp) ELEV))
           (setq IPXY (list (cadr TEMP) (caddr TEMP)))
          (setq m (+ n 1))
          (setq n (+ n 1))
      );end of progn
      (setq n (+ n 1))
        );end of if
    );end of while
       (setq el (rtos ELEV 2 2))
   (command "Layer" "M" FFILE "")

   (if (/= X 1)
       (command "insert" PTDWG ip BLKSCALE BLKSCALE 0 (fix (car pnt)) DESC el)
   );end of if


;    (command "insert" PTDWG ip 1 1 30 (fix (car pnt)) DESC el)
       (print (fix (car pnt)))
   (setq BNAME (vl-string-right-trim "+" (substr ATT 1 2)))
   (setq BNAME (vl-string-right-trim "-" BNAME))
   (setq BNAME (vl-string-right-trim "/" BNAME))
   (setq BNAME (vl-string-right-trim " " BNAME))
   (setq ATTLEN (strlen ATT))
       (setq PENCODE (substr ATT (- ATTLEN 1) 2))
   (if (= PENCODE "+1")
       (progn
           (setq PLVERTS2d (list IPXY))
           (setq PLVERTS (list IP))
           (setq NUMVERTS 1)
       )
   ); end if
       
   (if (= PENCODE "+2")

       (progn
           (setq PLVERTS2d (append PLVERTS2d (list IPXY)))
           (setq PLVERTS (append PLVERTS (list IP)))
           (setq NUMVERTS (+ NUMVERTS 1))
       )
   ); end if    

   (if (= PENCODE "+3")
       (progn
           (setq PLVERTS2d (append PLVERTS2d (list IPXY)))
           (setq PLVERTS (append PLVERTS (list IP)))
           (setq NUMVERTS 0)
           (command "LAYER" "M" BLKLAYER "")
           (command "PLINE" (foreach XXX PLVERTS2d (command XXX)))
           (command "LAYER" "M" (strcat "TOPO3d-" BNAME) "")
           (command "3dpoly" (foreach XXXX PLVERTS (command XXXX)))
           (command "LAYER" "M" FFILE "")
       )
         (if (= (substr ATT (- ATTLEN 1) 2) "+0") 
           (print "no lines"))
   ); end if

;loop to find block name
       (setq BLOCKS (open BLKDIR "r"))
   ;        (print COUNTER99)
   (while (< COUNTER99 10)
             (setq BDATA (read-line BLOCKS))
           (while     (/= BNAME (vl-string-right-trim " " (substr BDATA 1 2)))
               (setq BDATA (read-line BLOCKS))
               
           ) ; end of while
           (READBLOCK)
           ;(if     (= BNAME (substr BDATA 1 2))
           ;    (READBLOCK)
           ;    (setq BDATA (read-line BLOCKS))
           ;    
            ; end of if
   ;        (print BDATA)
           (setq COUNTER99 99)
;            (getstring "STOP")

       ); end of while
       (setq COUNTER99 1)
       (close BLOCKS)
   ;    (PRINT "HOWDY")
   );end of do-it

(defun READBLOCK ( / COUNTER NUMBLOCKS FC)
;     (getstring "READBLOCK MODULE Counter setup")
   (setq
       COUNTER 1
       NUMBLOCKS 143
       FC "AA"
          );end of setq
       (while (< COUNTER (+ NUMBLOCKS 1))
            (setq FC (vl-string-right-trim " " (substr BDATA 1 2)))
           (if (= FC BNAME)
               (progb)
               (setq COUNTER (+ COUNTER 1))
                );end of if
        );end of while
); end of READBLOCK

(defun PROGB ()
       (setq BLKNAME (vl-string-right-trim " " (substr BDATA 9 16)))
   ;        (print BLKNAME)
       (setq BLKLAYER (vl-string-right-trim " " (substr BDATA 25 15)))
   ;        (print BLKLAYER)
           (command "LAYER" "M" BLKLAYER "") 
       (setq BATT (substr BDATA 40 1))
           (if (= (vl-string-right-trim " " (substr BDATA 9 16)) "MISCSYMB")
               (setq BATT "4")); end IF

   (if (= BATT "3")
         (command "insert" BLKNAME ipxy BLKSCALE BLKSCALE 0 "" "" ""))
;          (command "insert" BLKNAME ip 1 1 0 "" "" ""))
   (if (= BATT "2")
         (command "insert" BLKNAME ipxy BLKSCALE BLKSCALE 0 "" ""))
;          (command "insert" BLKNAME ip 1 1 0 "" ""))
   (if (= BATT "1")        
         (command "insert" BLKNAME ipxy BLKSCALE BLKSCALE 0 ""))
;          (command "insert" BLKNAME ip 1 1 0 ""))
   (if (= BATT "0")
       (command "insert" BLKNAME ipxy BLKSCALE BLKSCALE 0 )    
;        (command "insert" BLKNAME ip 1 1 0 )
       )
       
   (setq COUNTER (+ NUMBLOCKS 1))
);end of progb

Maybe somethings to look into

instead of your 4 if statements consider cond

Getfiled instead of getstring when typing in a directory

entmake instead of command "_.insert"

I'd do something at the begining of the lisp like.

 
(foreach x '("blockname1" "blockname2" "blockname3" "blockname4")
 (if (not (tblsearch "block" x))
   (progn
     (setvar 'cmdecho 0)
     (command "_.insert" x nil)
     (setvar 'cmdecho 1)
   )
 )
)

Looked at a stringing program a couple of times as an ex civil software dealer the $1000 is probably money well spent, the software we use "Stringer" www.civilsurveysolutions.com.au does a lot more than just stringing the points as a front end to CIV3d. Where are you in the world

Anyway there is a way to string lines you need a pxyzd point xyz descriptor txt file you sort the file on descriptor but secondary sort on pt number as was surveyed order you then read each line check the descriptor and a external list and if a line then join together up to the point where the descriptor changes then start again , so in one paragraph thats a string programe.

Also cross section surveying is the way to go gives best model in conjunction with breaklines new survey instruments have this function built in so it remembers your codes.

Now for the smarts the descriptor can have stuff like 01f first fence pt, 01f*02f next fence point but start of fence 2, next point 01f fence 1 continues 02f joins auto to point in middle of last three 01f 01f 01f 01f*c close to first point 01f*as 01f 01f*ae draw a 3point arc

The stringer program is the one I was looking at. The problem with it is once we have it we have to completely setup a new system inside it.

Looks like it doesn't actually work when we use it in civil 3d 2011, the line work doesn't complete. We get a nil error or something like that.

Have you downloaded a demo etc try your codes as eb01 not eb+1 the + sign could be the problem our guys use numerics 40301 edge of road string 1 faster to type, alos if you have demo contact dealer they will probably supply a demo library for you to use they should have EB CL DR TBM PSM etc

post a sample of your data here

heres a list of the data. it goes PNEED

1006,5425936.373,321696.2883,39.053264,TF+0

1007,5425935.41,321696.2652,39.04745,TF+0

1008,5425936.865,321699.4686,39.34945,TB+1

1009,5425936.935,321701.93,39.112139,TB+2

1010,5425936.647,321703.0839,39.153939,TB+2

1011,5425936.53,321704.3993,39.326792,TB+3

So for the TB+1 -> TB+3 it creates a line. What would be nice is if when you were creating that line and saw say a catch basin you could go:

TB+1

TB+2

CB+0

TB+2

TB+3

Now I don't think you would use the +# anymore but that gives the general idea of what I'm hoping to do with this program.

Definately get rid of the + also I read tb1 tb2 tb3 as 3 different strings is that correct ? if not then all TB's should be TB1's the 1 is string one TB2 is second string TB3 is 3rd string and they do not join together.

In our library TB1 would work as is ! top of bank 1 and join all "TB1" in point number order.

Also talking to our surveyors they simply add a number to each new string rather than say having to remember the last string number for a individual code TB1 TB2 TB3 they may have TB11 TB42 Tb45 only restriction is when they hit 99

Hej!

I need a LISP which imports multiple blocks out from a ascii file. Should work some how:

* choose file (or first over static adress)

* load block from file by (BLOCKNAME, X, Y, Z, SCALING, ROTATION, ATTRIBUTE1, ATTRIBUTE2, .., ATTIRBUTEx)

Is that possible? How?

Kind regards, Jürgen