(defun c:NCNYAZ(/ baslik NR NP ZN PD B old_cmdecho)
    (setq old_cmdecho (getvar "cmdecho"))
    (setvar "cmdecho" 0)



    (initget (+ 1 2 4))
(setq baslik (getstring "\nBASLIK GIRINIZ :"))
    (setq NR (getint "\nBaslama Numarası Giriniz :"))
(setq ZKOOR (getstring "\nZ KOORDINATI GIRINIZ :"))

    (setq B (getreal "\Numara Boyunu Giriniz:"))
    (setq NP (getfiled "Kayıt Yapılacak Dosyayı Seçiniz" "" "ncn" 1))
   
;(setq ZN (getstring "\Noktaya balastro istermisiniz ?  [ e / h ]:"))
(setq ZN "E")

;Koordinat çizelge anteti
(setq P1 (getpoint "\nKoordinat listesi köşe noktasını seçiniz:"))
(setq P2 (polar p1 0 5))
(setq P3 (polar p1 0 20))
(setq P4 (polar p1 0 35))
(setq P12 (polar p1 (/ pi 2) 3))
(setq P22 (polar p2 (/ pi 2) 3))
(setq P32 (polar p3 (/ pi 2) 3))
(setq P42 (polar p4 (/ pi 2) 3))
(setq P11 (polar p1 (/ pi 4) 1))
(setq P21 (polar p2 (/ pi 4) 1))
(setq P31 (polar p3 (/ pi 4) 1))

(command "_layer" "_m" "cizelge" "_c" "3" "" "")

(setvar "osmode" (logior (getvar "osmode") 16384)) ;OSNAP OFF
(command "LINE" p1 p4 "" "")
(command "LINE" p12 p42 "" "")
(command "LINE" p12 p1 "" "")
(command "LINE" p22 p2 "" "")
(command "LINE" p32 p3 "" "")
(command "LINE" p42 p4 "" "")

(command "-text" "j" "bl" p11 B "" "N.No" "")
(command "-text" "j" "bl" p31 B "" "X.Koord." "")
(command "-text" "j" "bl" p21 B "" "Y.Koord." "")
(command "_layer" "_m" "nokta" "_c" "3" "" "")
    (setvar "osmode" (logand (getvar "osmode") (~ 16384))) ; OSNAP ON

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


    (SETQ PD (open NP "a"))
   
        (while
  (setq NOKTA (getpoint "\nNokta Sec:"))
  (setq Y (RTOS (car NOKTA) 2 4))
  (setq X (RTOS (cadr NOKTA) 2 4))
  (setq Z ZKOOR)  ;(RTOS (caddr NOKTA)2 4)
  (setq LINIA
  (strcat (chr 34) baslik (rtos NR 2 0) (chr 34) " " Y " " X " " Z " 0 " (chr 34) (chr 34) " " (chr 34) (chr 34) " " (chr 34) (chr 34));strcat
  )
 
  ; Çizelge kord. yazan kısım
 
  (setq P1B (polar p1 (/ (- pi) 2 ) 3))
  (setq P2B (polar p2 (/ (- pi) 2 ) 3))
  (setq P3B (polar p3 (/ (- pi) 2 ) 3))
  (setq P4B (polar p4 (/ (- pi) 2 ) 3))
 
  (setq P11B (polar p11 (/ (- pi) 2 ) 3))
  (setq P21B (polar p21 (/ (- pi) 2 ) 3))
  (setq P31B (polar p31 (/ (- pi) 2 ) 3))

  (command "_layer" "_m" "cizelge" "_c" "3" "" "")
  (setvar "osmode" (logior (getvar "osmode") 16384)) ;OSNAP OFF
  (command "LINE" p1 p1B "")
  (command "LINE" p2 p2B "")
  (command "LINE" p3 p3B "")
  (command "LINE" p4 p4B "")
  (command "LINE" p1B p4B "")
  (command "-text" "j" "bl" p11B B "" (strcat baslik (rtos NR 2 0)) "")
  (command "-text" "j" "bl" p31B B "" X "")
  (command "-text" "j" "bl" p21B B "" Y "")
  (setvar "osmode" (logand (getvar "osmode") (~ 16384))) ; OSNAP ON
  (command "_layer" "_m" "nokta" "_c" "3" "" "")
 
  (setq p1 p1b)
  (setq p2 p2b)
  (setq p3 p3b)
  (setq p4 p4b)
 
  (setq p11 p11b)
  (setq p21 p21b)
  (setq p31 p31b) 
 
  ;

      (WRITE-line LINIA PD)
  (if (or (= ZN "E")(= ZN "e"))
    (progn
     (DRAW_PUNKT)
     (DRAW_TEXT)
    )
     (DRAW_TEXT)
  )
  (setq NR (1+ NR))
);WHILE
    (close PD)
    (setvar "cmdecho" old_cmdecho)
    (princ "\nKoniec")
    (princ)
  );defun
;;;  ;;;
(defun DRAW_TEXT (/)
  (command "_layer" "_m" "nokta-no" "_c" "3" "" "")
  (command "_text" NOKTA B "0" (strcat baslik (rtos NR 2 0)))
  );defun
;;;  ;;;
(defun DRAW_PUNKT (/ d kat_90 kat_270 p1 p2 p3 p4)
      (command "_layer" "_m" "nokta" "_c" "3" "" "")
(setq d (/ B 20))
  (command "_point" NOKTA )
  );defun
;;;  ;;;
(princ
  (strcat
    "FERIDUN.Lsp (C) Dariusz Ptaszkiewicz"
" Düzenleyen Alpay ELMAS"
    " [e-mail:alpayelmas@gmail.com]"
    "\nKomut: NCNYAZ "
  )
)



   

 
               
                      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                      ;;                                           ;;
                      ;; Title  : Import coordinate                ;;
                      ;; Purpose: Import coordinate & create table ;;
                      ;; Written: Bijoy Manoharan                  ;;
                      ;; Command: IMPO, CRT                        ;;
                      ;; Date   : May-2012                         ;;
                      ;;                                           ;;
                      ;; Website: www.cadlispandtips.com           ;;
                      ;;                                           ;;
                      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;





;; ----------------------------------sub function error--------------------------------

(defun trap1 (errmsg)

           (setvar "attdia" ad)
   (setvar "attreq" aq)
           (setq *error* temperr)
           ;(command "UCS" "P")
           (prompt "\n *** File not Found or Incorrect Format ***\n © Bijoy Manoharan 2012 www.cadlispandtips.com")
(princ)
) ;defun

;;-----------------------------------sub function to create block-----------------------

(defun crb ( )
    (if (not (tblsearch "BLOCK" "CRBLK"))
        (progn
            (if (not (tblsearch "STYLE" "Gen-Text"))
                (entmake
                    (list
                        (cons 0 "STYLE")
                        (cons 100 "AcDbSymbolTableRecord")
                        (cons 100 "AcDbTextStyleTableRecord")
                        (cons 2 "Gen-Text")
                        (cons 70 0)
                        (cons 40 2.5)
                        (cons 3 "Arial.ttf")
                    )
                )
            )
            (entmake
                (list
                    (cons 0 "BLOCK")
                    (cons 8 "0")
                    (cons 370 0)
                    (cons 2 "CRBLK")
                    (cons 70 2)
                    (cons 4 "Block to Place Coordinate Points")
                    (list 10 0.0 0.0 0.0)
                )
            )
            (entmake
                (list
                    (cons 0 "CIRCLE")
                    (cons 8 "0")
                    (cons 370 0)
                    (list 10 0.0 0.0 0.0)
                    (cons 40 1.25)
                )
            )
            (entmake
                (list
                    (cons 0 "ATTDEF")
                    (cons 8 "0")
                    (cons 370 0)
                    (cons 7 "Gen-Text")
                    (list 10 3.0 2.5 0.0)
                    (list 11 3.0 2.5 0.0)
                    (cons 40 2.5)
                    (cons 1 "00")
                    (cons 3 "Coordinate Point")
                    (cons 2 "OO")
                    (cons 70 0)
                    (cons 72 0)
                    (cons 74 2)
                )
            )
            (entmake
                (list
                    (cons 0 "ENDBLK")
                    (cons 8 "0")
                )
            )
         
           ;;--- To set block units in metre 70-6
           
            (
                (lambda ( lst )
                    (regapp "ACAD")
                    (entmod
                        (append (subst (cons 70 6) (assoc 70 lst) lst)
                            (list
                               (list -3
                                   (list "ACAD"
                                       (cons 1000 "DesignCenter Data")
                                       (cons 1002 "{")
                                       (cons 1070 1)
                                       (cons 1070 1)
                                       (cons 1002 "}")
                                   )
                               )
                           )
                        )
                    )
                )
                (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" "CRBLK")))))
            )
        )
    )
       ;;;--- to disable allow explod-----

       (vl-load-com)
       (setq BLOCKS
       (vla-get-Blocks
        (vla-get-activedocument
         (vlax-get-acad-object)
        )
       )
      BLK (vla-Item BLOCKS "CRBLK")
    )
   (vla-put-explodable (vla-Item BLOCKS "CRBLK") :vlax-false)

    (princ)
)


;; ----------------------------------Sub function--------------------------------

(DEFUN IMPPS (/ TXTF)
  (SETQ TXTF (GETVAR "dwgname"))
  (IF (WCMATCH (STRCASE TXTF) "*`.DWG")
      (SETQ
      TXTF
      (STRCAT (GETVAR "dwgprefix") TXTF)
      TXTF
      (SUBSTR TXTF 1 (- (STRLEN TXTF) 4))
    )
  )
  TXTF
)


;; ----------------------------------Main function--------------------------------

(defun C:NCNOKU (/ CRDS ENCR ENNO ENNO1 CRPT DATA th )

           (command "cmdecho"0)
           (setq clay (getvar "clayer"))
           (setq ad (getvar "attdia"))
           (setq aq (getvar "attreq"))
           (setq temperr *error*)
           (setq *error* trap1)
           (setvar "attdia" 0)
           (setvar "attreq" 1)

   ;;; variable input values
          (if (not df-hs) (setq df-hs 1000.0))    ; default horizontal scale
         
   ;;; input horizontal scale
          (setq hs (getreal (strcat "\nEnter scale 1:<" (rtos df-hs 2 0) ">: ")))
          (if (not hs) (setq hs df-hs) (setq df-hs hs))
         
          (setq cv 1000.0)                       ; annotation multipiclation factor (eg. 1000 will diplay m as mm)
          (setq th (/ hs 1000.0))                ; scale factor to be applied to block   

   (SETQ Data (GETFILED "Select Text File to Import" (IMPPS) "" 0))

   (SETQ CRDS (OPEN Data "r"))


   (setq ENCR 0)
   (command "UCS" "WORLD")
 
(while (/= ENCR nil)
      (setq ENCR (read-line CRDS)) ;Read ENCR from input file
     
     
(if (/= ENCR nil)
         (progn
            (crb) ;create block           
            (setq ENCR (strcat "(" ENCR ")")) ;Correct format
            (setq ENCR (read ENCR))           ;Convert to list
            (setq ENNO (nth 0 ENCR))          ;Get the CRPT number

       (cond
             ((= (type ENNO) 'STR)       
              (setq ENNO1 ENNO)
             )

             ((and (< ENNO 10.0)(= (type ENNO) 'INT))       
                   (setq ENNO1 (strcat "0" (rtos ENNO 2 0)))
             )

             ((and (>= ENNO 10.0)(= (type ENNO) 'INT))       
                   (setq ENNO1 (rtos ENNO 2 0))
             )
       
     
        ) ;cond
           
            (setq CRPT
               (list                 
                  (nth 1 ENCR) ;Get easting
                  (nth 2 ENCR) ;Get northing
               )
            )

;create new layer

           (if (not (tblsearch "layer" "Coordinate Points")) (command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.00" "Coordinate Points" ""))     
           (command "CLAYER" "Coordinate Points")                     
           (command "-insert" "CRBLK" "_NON" CRPT th th "0" ENNO1)
                     
        )
      )
   )
   
   (command "UCS" "P")   
   (setvar "clayer" clay)
   (close CRDS)
   (prompt "\n Zoom Extend to View All Points & Enter Command CRT to Create Table....")

) ;defun

;;---------- sub function for Table----------

(defun CRTable ()       
       
(setq LEN (length CORDS))
(setq CORDS (acad_strlsort CORDS)) ;;;sorts list into order
(setq CNT 0)
(if (= (getvar "tilemode") 1) (setvar "tilemode" 0))
(command "pspace")

(setq SP (getpoint "\nPick start point for table"))

        (setq ht 2.5) ;; text hieght
       
        (command "-style" "Gen-Text" "Arial.ttf" 2.5 "1" 0 "n" "n")
        (if (not (tblsearch "layer" "Coordinate Table"))
        (command "-LAYER" "N" "Coordinate Table" "C" "7" "Coordinate Table" "LT" "Continuous" "Coordinate Table""LW" "0.00" "Coordinate Table" ""))

(if (/= SP nil) ;;;checks for null input
  (progn
    (setq TXTX (car SP)) ;;;gets x coord of text start point
    (setq fx txtx)                                      ;;; set first x value
   
    (setq TXTY (cadr SP)) ;;;gets y coord
    (setq fy TXTY)
   
    (setq encw 25.00)  ; easting & northing Column width
            (setq nocw 20.00)  ; number Column width           
           
            (setq ten (/ encw 2))
            (setq tno (+ (/ nocw 2) ten))
 
     ;; place easting & northing text
    (entmake
      (list
        (cons 0 "text")
        (cons 1 "KOORDINATLAR")
        (cons 7 "Gen-Text")
        (cons 8 "Coordinate Table")
        (cons 10 (list (+ TXTX 2.5) (+ TXTY (/ ht 2) (* ht 2))))
        (cons 11 (list (+ TXTX 2.5) (+ TXTY (/ ht 2) (* ht 2))))
        (cons 40 3.0)
        (cons 50 0.0)
        (cons 72 4)
      )
    )
     
    (entmake
      (list
        (cons 0 "text")
        (cons 1 "NOKTA")
        (cons 7 "Gen-Text")
        (cons 8 "Coordinate Table")
        (cons 10 (list (- TXTX tno) TXTY))
        (cons 11 (list (- TXTX tno) TXTY))
        (cons 40 ht)
        (cons 50 0.0)
        (cons 72 4)
      )
    )
       
    (entmake
      (list
        (cons 0 "text")
        (cons 1 "X KOORD")
        (cons 7 "Gen-Text")
        (cons 8 "Coordinate Table")
        (cons 10 (list TXTX TXTY))
        (cons 11 (list TXTX TXTY))
        (cons 40 ht)
        (cons 50 0.0)
        (cons 72 4)
      )
    ) 
       
    (entmake
      (list
        (cons 0 "text")
        (cons 1 "Y KOORD")
        (cons 7 "Gen-Text")
        (cons 8 "Coordinate Table")
        (cons 10 (list (+ TXTX encw) TXTY))
        (cons 11 (list (+ TXTX encw) TXTY))
        (cons 40 ht)
        (cons 50 0.0)
        (cons 72 4)
      )
    )     
     
     ;; place easting & northing horizontal table lines
    (entmake
      (list
        (cons 0 "line")
        (cons 8 "Coordinate Table")
        (cons 10 (list (- TXTX (+ ten nocw)) (+ TXTY ht)))
        (cons 11 (list (+ TXTX ten encw) (+ TXTY ht)))
      )
    )
     
    (entmake
      (list
        (cons 0 "line")
        (cons 8 "Coordinate Table")
        (cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht)))
        (cons 11 (list (+ TXTX ten encw) (- TXTY ht)))
      )
    )
 
  (repeat LEN
(setq TXTY (- TXTY (* 2 HT))) ;;;set new y coord for text

(setq SP (list TXTX TXTY)) ;;;creates code start point
(setq CORD (nth CNT CORDS)) ;;;gets coord from list
(setq COLEN (strlen CORD))
(setq COM 1 GAP 1)

(while (/= COLEN COM)
(setq COM1 (substr CORD COM 1))
(if (and (= COM1 ",") (= GAP 1)) (setq S1 COM GAP 2))
(if (and (= COM1 ",") (= GAP 2)) (setq S2 COM))
(setq COM (+ COM 1))
) ;while

(setq CODE (substr CORD 1 (- S1 1))) ;;;strips of code
(setq SON (substr CORD (+ S1 1) (- S2 S1 1))) ;;;strips of north
(setq SOE (substr CORD (+ S2 1) (- COLEN S2))) ;;;strips of east

        (entmake
          (list
            (cons 0 "text")
            (cons 1 code)
            (cons 7 "Gen-Text")
            (cons 8 "Coordinate Table")
            (cons 10 (list (- TXTX tno) TXTY))
            (cons 11 (list (- TXTX tno) TXTY))
            (cons 40 ht)
            (cons 50 0.0) (cons 72 4)
          )
        )
       
        (entmake
          (list
            (cons 0 "text")
            (cons 1 soe)
            (cons 7 "Gen-Text")
            (cons 8 "Coordinate Table")
            (cons 10 (list TXTX TXTY))
            (cons 11 (list TXTX TXTY))
            (cons 40 ht)
            (cons 50 0.0)
            (cons 72 4)
          )
        )
 
  (entmake
    (list
      (cons 0 "text")
      (cons 1 son) (cons 7 "Gen-Text")
      (cons 8 "Coordinate Table")
      (cons 10 (list (+ TXTX encw) TXTY))
      (cons 11 (list (+ TXTX encw) TXTY))
      (cons 40 ht)
      (cons 50 0.0)
      (cons 72 4)
    )
  )
   
                (entmake
                  (list
                    (cons 0 "line")
                    (cons 8 "Coordinate Table")
                    (cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht)))
                    (cons 11 (list (+ TXTX ten encw) (- TXTY ht)))
                  )
                ) ;; horizontal lines

(setq hl (entlast)) ; set hl as last horizontal line

(setq CNT (+ CNT 1))

    ) ;repeat
   
                (setq ly (caddr (assoc 10 (entget hl)))) ;set last y value
               
      ;; place easting & northing vertical table lines
               (entmake
                  (list
                    (cons 0 "line")
                    (cons 8 "Coordinate Table")
                    (cons 10 (list (- fx ten) (+ fy ht)))
                    (cons 11 (list (- fx ten) ly))
                  )
               )
               
               (entmake
                  (list
                    (cons 0 "line")
                    (cons 8 "Coordinate Table")
                    (cons 10 (list (+ fx ten) (+ fy ht)))
                    (cons 11 (list (+ fx ten) ly))
                  )
               )
       
       (entmake
          (list
            (cons 0 "LWPOLYLINE")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbPolyline")
            (cons 8 "Coordinate Table")
            (cons 90 4)
            (cons 70 1)
            (cons 10 (list (- fx (+ ten nocw)) (+ fy (* ht 4))))
            (cons 10 (list (+ fx (+ ten encw)) (+ fy (* ht 4))))
            (cons 10 (list (+ fx (+ ten encw)) ly))
            (cons 10 (list (- fx (+ ten nocw)) ly))
          )
               ) ; inner rectangle

       (entmake
          (list
            (cons 0 "LWPOLYLINE")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbPolyline")
            (cons 8 "Coordinate Table")
            (cons 90 4)
            (cons 70 1)
            (cons 10 (list (- fx (+ ten nocw 1)) (+ fy (* ht 4) 1)))
            (cons 10 (list (+ fx (+ ten encw 1)) (+ fy (* ht 4) 1)))
            (cons 10 (list (+ fx (+ ten encw 1)) (- ly 1)))
            (cons 10 (list (- fx (+ ten nocw 1)) (- ly 1)))
          )
               ) ; outer rectangle

(command "erase" hl "")

  ) ; progn
) ;if
(command "redraw")
(princ)

) ; defun


;;-------------Main function to make List of points-----

(defun c:CRT (/ txtx txty len cord cords cnt sp ht code son soe sox soy so1 encw nocw ten tno lat hl ly fx fy)

(setvar "cmdecho" 0)

(setq temperr *error*)
        (setq *error* trap3)
       
(setq CORDS nil LEN nil CNT 0) ;;resets coord list to nil
(princ (strcat "\n "))

(initget 1 "All Select")
(setq sel (strcase (getkword "\Select individual coordinate points or Select All (S or A): ")))
(if (= sel "SELECT") (setq SS (ssget '((2 . "crblk")))) (setq SS (ssget "X" '((2 . "crblk")))))
 
(command "UCS" "WORLD")

(while (/= SS nil) ;;;checks for nil selection
  (setq LEN (sslength SS))
    (repeat LEN
(setq SO0 (ssname SS CNT))
(setq CORD (cdr (assoc '10 (entget SO0)))) ;;;gets coords of point
(setq SOX (rtos (car CORD) 2 3)) ;;;strips off X coord
(setq SOY (rtos (cadr CORD) 2 3)) ;;;strips off Y coord
(setq SO1 (entnext SO0)) ;;;gets attribute entity
(setq CODE (cdr (assoc '1 (entget SO1)))) ;;;strips off point code from attribute
(setq CORD (strcat CODE "," SOY "," SOX)) ;;;creates string of code,y,x
(setq CORDL (list CORD)) ;;;converts into list
(if (= CORDS nil) (setq CORDS CORDL) (setq CORDS (append CORDL CORDS))) ;;;starts new list or adds to old
(setq CNT (+ CNT 1))
    )
  (setq SS nil)
) ;while

(command "UCS" "P")

(if (/= (length CORDS) 0) (CRTable))

(setq *error* temperr)
(prompt "\n Coordinate Table is Placed\n © Bijoy.v.m 2012 www.cadlispandtips.com")
(princ)
) ;defun


;;------------- end Main function --------------------

(alert "----------------------- Import Coordinates & Export to Table --------------------------

\n Commands       
\n    Command :  NCNYAZ ( For Export Coordinate Data Points )                                   
\n    Command :  NCNOKU ( For Import Coordinate Data Points )
\n    Command :  CRT  ( To Create Coordinate Table )
\n Steps
\n 1. Enter appropriate Scale (in A1) to be drawn
\n 2. Select Coordinate Data TXT File
\n 3. After Importing Coordinate Points run Command CRT to place table   
\n 4. Type A to select all coordinate points
\n 5. Type S to select individual coordinate points
\n 6. Pick a point to place Coordinate Table.
\n Note
\n TXT File Format : Number  Easting  Northing
\n eg.    100   00000.000  00000.000


\nBijoy Manoharan\nMay 2012\nwww.cadlispandtips.com")

(princ "\nImport coordinate Lisp | © Bijoy manoharan 2012 www.cadlispandtips.com")
(princ "\nLisp Command:IMPO (to Import Coordinates Points)   ")
(princ)