CPLink Update

[StuboJones]

Afternoon all,

This is a programme that I've been using for a couple of years now, but dont know the author. (If you're reading this, thank you for the countless hours you've saved me )

My question is;

'Would be possible to give it a makeover so as to co-ordinate the Z value as well, both on screen and to txt/csv file?'

 

(defun C:CPLINK ( / cmdecho temp mode sno pno it un l ctable
                   cx1 cx2 cx3 cy p date p1 cy1)
;
;     Initialise
;     ----------
     (setq cmdecho (getvar "CMDECHO"))
     (setvar "CMDECHO" 0)
;
;     Get Filename
;     ------------
     (if (null $CPFNAME) (setq $CPFNAME (strcat (getvar "DWGNAME") ".txt")))
     (setq temp (getstring (strcat "\nFilename <" $CPFNAME "> :")))
     (if (/= "" temp) (setq $CPFNAME temp))
;
;     Check file existance
;     --------------------
     (setq fx (findfile $CPFNAME))
     (if (null fx)
       (progn
         (princ "New File\n")
         (setq mode "w" sno 1)
       )
       (progn
         (initget "Overwrite Append Quit")
         (setq it (getkword "File Exists <Overwrite>/Append/Quit :"))
         (cond
           ((= it "Append")
             (setq mode "a")
             (setq un (open $CPFNAME "r"))
             (setq l T)
             (setq sno 0)
             (while (not (null l))
               (setq l (read-line un))
               (if (not (null l))
                 (progn
                   (if (/= (substr l 1 1) "*") (setq sno (atoi l)))
                 )
               )
             )
             (close un)
             (setq sno (1+ sno))
           )
           ((= it "Quit")
             (setq mode nil)
           )
           (T
             (setq mode "w")
             (setq sno 1)
           )
         )
       )
     )
;
;     Get start point number
;     ----------------------
     (if (not (null mode))
       (progn
         (initget (+ 2 4))
         (setq temp (getint (strcat "\nStart point number <" (itoa sno) "> :")))
         (if (null temp) (setq temp sno))
         (setq sno temp)
         (setq pno 0)
;
;     Circle Radius
;     -------------
         (if (null $CPRAD) (setq $CPRAD 0.5))
         (initget (+ 2 4))
         (setq temp (getdist (strcat "\nCircle Radius <" (rtos $CPRAD) "> :")))
         (if (null temp) (setq temp $CPRAD))
         (setq $CPRAD temp)
;
;     Text Height
;     -----------
         (if (null $CPTXT) (setq $CPTXT (* $CPRAD 2.0)))
         (initget (+ 2 4))
         (setq temp (getdist (strcat "\nText Height <" (rtos $CPTXT) "> :")))
         (if (null temp) (setq temp $CPTXT))
         (setq $CPTXT temp)
;
;     Text Angle
;     ----------
         (if (null $CPANG) (setq $CPANG 0.0))
         (initget (+ 2 4))
         (setq temp (getreal (strcat "\nText Angle <" (rtos $CPANG) "> :")))
         (if (null temp) (setq temp $CPANG))
         (setq $CPANG temp)
;
;     Coordinate Table?
;     -----------------
         (initget "Yes No")
         (setq ctable nil)
         (if (= (getkword "\nCoordinate Table Yes/<No> :") "Yes") (setq ctable T))
;
;     If Coordinate table required - get origin - and initialise
;     ----------------------------------------------------------
         (if ctable
           (progn
             (initget 1)
             (setq corg (getpoint "\nCoordinate Table Origin (Top/Left) :"))
             (setq cx1 (+ (car corg) (* $CPTXT 4.0)))
             (setq cx2 (+ cx1 (* $CPTXT 10.0)))
             (setq cx3 (+ cx2 (* $CPTXT 10.0)))
             (setq cy (- (cadr corg) (* $CPTXT 5.0)))
           )
         )
       )
     )
;
;     Open the File
;     -------------
     (if (not (null mode))
       (progn
         (setq un (open $CPFNAME mode))
         (if (null un)
           (progn
             (princ "\nUnable to open file\n")
           )
           (progn
             (if (= mode "w")
               (progn
                 (write-line "*" un)
                 (write-line (strcat "* File Generated from drawing " (getvar "DWGNAME")) un)
                 (write-line "*" un)
                 (write-line "* File Format:-" un)
                 (write-line "*               Point Number   Easting   Northing" un)
                 (write-line "*" un)
               )
             )
             (setq p (getvar "CDATE"))
             (setq date (rtos p 2 4))
             (setq l (strcat (substr date 7 2) "-" (substr date 5 2) "-" (substr date 1 4) " " (substr date 10 2) ":" (substr date 12 2)))
             (write-line "*" un)
             (write-line (strcat "* Created: "  l) un)
             (write-line "*" un)
;
;     Get a series of digitises
;     -------------------------
             (setq p T)
             (while (not (null p))
               (setq p (getpoint (strcat "\nPoint number " (itoa sno) ": ")))
;
;     If we got a digitise
;     --------------------
               (if (not (null p))
                 (progn
;
;     Write Point Number and X,Y coordinates to file
;     ----------------------------------------------
                   (setq l (strcat (itoa sno) "   " (rtos (car p) 2 3) "   " (rtos (cadr p) 2 3)))
                   (write-line l un)
;
;     Draw the symbol
;     ---------------
                   (command "CIRCLE" p $CPRAD)
                   (setq p1 (polar p 0.785398163 $CPRAD))
                   (command "TEXT" p1 $CPTXT $CPANG (itoa sno))
;
;     If we have a coordinate table - add to it
;     -----------------------------------------
                   (if ctable
                     (progn
                       (setq OSMode (getvar "OSMODE"))
                       (setvar "OSMODE" 0)
                       (setq p1 (list cx1 cy 0.0))
                       (command "TEXT" "Right" p1 $CPTXT 0.0 (itoa sno))
                       (setq p1 (list cx2 cy 0.0))
                       (command "TEXT" "Right" p1 $CPTXT 0.0 (rtos (car p) 2 3))
                       (setq p1 (list cx3 cy 0.0))
                       (command "TEXT" "Right" p1 $CPTXT 0.0 (rtos (cadr p) 2 3))
                       (setq cy (- cy (* $CPTXT 2.0)))
                       (setvar "OSMODE" OSMode)
                     )
                   )
;
;     Increment Point number
;     ----------------------
                   (setq sno (1+ sno))
                   (setq pno (1+ pno))
                 )
               )
             )
;
;     Close the file
;     --------------
             (close un)
;
;     If any points were specified and we have a coordinate table...
;     --------------------------------------------------------------
             (if (and (/= pno 0) ctable)
               (progn
;
;     Draw the table Outline
;     ----------------------
                 (setq OSMode (getvar "OSMODE"))
                 (setvar "OSMODE" 0)
                 (setq cy1 (cadr corg))
                 (command "PLINE"  corg
                                   (list (+ cx3 $CPTXT) cy1)
                                   (list (+ cx3 $CPTXT) cy)
                                   (list (car corg) cy)
                                   "CLOSE")
                 (command "LINE"   (list (car corg) (- cy1 (* $CPTXT 3.0)))
                                   (list (+ cx3 $CPTXT) (- cy1 (* $CPTXT 3.0)))
                                   "")
                 (command "LINE"   (list (+ cx1 $CPTXT) cy1)
                                   (list (+ cx1 $CPTXT) cy)
                                   "")
                 (command "LINE"   (list (+ cx2 $CPTXT) cy1)
                                   (list (+ cx2 $CPTXT) cy)
                                   "")
                 (setq p1 (list cx1 (- cy1 (* $CPTXT 2.0)) 0.0))
                 (command "TEXT" "Right" p1 $CPTXT 0.0 "PNO.")
                 (setq p1 (list cx2 (- cy1 (* $CPTXT 2.0)) 0.0))
                 (command "TEXT" "Right" p1 $CPTXT 0.0 "EASTING")
                 (setq p1 (list cx3 (- cy1 (* $CPTXT 2.0)) 0.0))
                 (command "TEXT" "Right" p1 $CPTXT 0.0 "NORTHING")
                 (setvar "OSMODE" OSMode)
               )
             )
           )
         )
       )
     )    
 
     (setvar "CMDECHO" cmdecho)
     (princ)
)

 

Thanx for your time gents, hope you can help me out.

 

Stu