2013 Old lisp not working fully in new versions

[Hannan1]

Hi every one,

I need help to fix below lisp code to work in latest Autocad versions,

Lisp run perfect but when it comes to attributes it is not working,

It seems like inserting field have problem and also opens window box and cannot insert field it self i have attached here screenshot.

; ---------------------------------------------------------------------------

; Sub-routines
(Defun SetUnits () 
                (command "units" 2 4 1 4 0 "N")
                (command "units" 2 4 2 4 90 "Y") ; Set UNITS to DMS
                (setvar "osmode" 0)
)

(Defun ResUnits () (command "units" 2 4 1 4 0 "N"))
(Defun DTR (D) (/ (* d pi) 180.0))   ; convert degrees to radians
(Defun RTD (R) (/ (* r 180.0) pi))   ; convert radians to degrees
;(Defun KM_Err (err_msg) (beep) (princ (strcat "\n" err_msg)))
(Defun KM_Err (err_msg) (beep) (alert err_msg))
; ---------------------------------------------------------------------------
; Sub-routine to filter fields from the line read in from the input file
(Defun FIELD (s)
   (while (and (/= (substr s 1 1) " ") (/= (substr s 1 1) ",")
               (/= (substr s 1 1) "\t"))
      (setq s (substr s 2)))
)
; ---------------------------------------------------------------------------
(Defun LTRIM (s / c)
   (setq c (substr s 1 1))
   (while (or (eq c " ") (eq c ",") (eq c "\t")) 
       (setq s (substr s 2) c (substr s 1 1))
  )
   (cond ((eq s "") nil) (t s))
)
; ---------------------------------------------------------------------------
(Defun RTRIM (s / c)
   (setq c (substr s (strlen s)))
   (while (or (eq c " ") (eq c ",") (eq c "\t"))
      (setq s (substr s 1 (1- (strlen s))) c (substr s (strlen s))))
   (cond ((eq s "") nil) (t s))
)
; ---------------------------------------------------------------------------
(Defun DblQoteTrim (s / c)
   (setq c (substr s 1 1))
   (while (eq c "\"") (setq s (substr s 2) c (substr s 1 1)))
   (setq c (substr s (strlen s)))   
   (while (eq c "\"") (setq s (substr s 1 (1- (strlen s))) c (substr s (strlen s))))   
   (cond ((eq s "") nil) (t s))
)
; ---------------------------------------------------------------------------
(Defun ftrtrim (F_Fld / dummy)

   (if (wcmatch F_Fld "*-*")
      (Progn                 
          (while (/= "-" (substr F_Fld 1 1))
              (setq F_Fld (substr F_Fld 2))
          )
       (setq F_Fld (substr F_Fld 2))
  
      )
   )
 
  (setq dummy  (atoi F_Fld))
  (setq F_Fld (if (eq dummy 0) "T000" (strcat "T" (itoa dummy))))
)
; ---------------------------------------------------------------------------
(Defun Assign_Fld ( / Z_len)
   (setq Temp     nil
         P_Fld    nil
         F_Fld    nil
         X_Fld    nil
         Y_Fld    nil
         Z_Fld    nil
         STA_Name nil
         Stake_XY nil
         inline   (LTRIM (RTRIM inline))
         Temp     inline
         inline   (Field inline)
         P_Fld    (substr Temp 1 (- (strlen Temp) (strlen inline)))    ; Point Number 
          
         inline   (LTRIM inline)                            
         Temp     inline
         inline   (Field inline)
         F_Fld    (substr Temp 1 (- (strlen Temp) (strlen inline)))    ; String-Feature Code (or Feature Code alone)
         F_Fld    (DblQoteTrim F_Fld)
         
         inline   (LTRIM inline)
         Temp     inline
         inline   (Field inline)
         X_Fld    (substr Temp 1 (- (strlen Temp) (strlen inline)))    ; Easting
         X_Fld    (atof X_Fld)

         inline   (LTRIM inline)
         Temp     inline
         inline   (Field inline)
         Y_Fld    (substr Temp 1 (- (strlen Temp) (strlen inline)))    ; Northing
         Y_Fld    (atof Y_Fld)

         Stake_XY (list X_Fld Y_Fld)
         Stake_XY (if (> (car Stake_XY) (cadr Stake_XY)) (reverse Stake_XY) Stake_XY)

         inline   (LTRIM inline)
         Z_Fld    (atof inline)                                        ; Elevation
         Z_len    (strlen (rtos Z_Fld 2 3))
   )      

   (if (> (strlen inline) Z_len) 
        (setq inline (substr inline (+ Z_len 2))
              STA_Name (if (/= (strlen inline) 0) inline nil)           ; Comment
        )
   )
   (setq STA_Name (DblQoteTrim STA_Name))
)
; ---------------------------------------------------------------------------
(Defun WL (xy tang sta_name / x_str y_str ds ang_str)
   (setq x_str (rtos (car xy) 2 3) y_str (rtos (cadr xy) 2 3))
   (if (or (eq (ascii tang) 76) (eq (ascii tang) 82))
      (setq ds      (if (eq (ascii tang) 76) "L" "R")
            ang_str (substr tang 2)
            ang_str (cond ((eq (strlen ang_str) 7) (strcat "0" ang_str))
                          ((eq (strlen ang_str) 6) (strcat "00" ang_str))
                          (t ang_str))
      )
      (setq ds "" ang_str tang)
   )
   ;(write-line (strcat x_str " " y_str " " ds ang_str " " sta_name) fptr2)
)
; ---------------------------------------------------------------------------
(Defun INS_PI (I_Pt R_Pt T_Ang PI_No / X Y e_list main_ent sub_ent e_line)
   (setq X (rtos (car I_Pt) 2 2)
         Y  (rtos (cadr I_Pt) 2 2)
         X  (strcat (substr X 1 3) " " (substr X 4) " E")
         Y  (strcat (substr Y 1 1) " " (substr Y 2 3) " " (substr Y 5) " N")
   )
   (STA_CIR I_Pt)
   (setvar "clayer" "F977")
   (command "insert" "PISTAKE" I_Pt blksf blksf R_Pt X Y T_Ang PI_No)

   ; Replace the attributes in PISTAKE block with textual elements
   (setq e_list (entget (setq main_ent (entlast))))

   (if (and (eq "INSERT" (cdr (assoc 0 e_list)))
            (eq "PISTAKE" (cdr (assoc 2 e_list)))) (Progn
      (setq sub_ent (entnext main_ent))          
      (while (/= "SEQEND" (cdr (assoc 0 (setq e_list (entget sub_ent)))))
         (setq e_list (cdr e_list)
               e_list (subst (cons 0 "TEXT") (assoc 0 e_list) e_list)
               e_list (list (assoc 0 e_list) '(8 . "F977") 
                            (assoc 10 e_list) (assoc 40 e_list)
                            (assoc 1 e_list) (assoc 50 e_list)
                            (assoc 41 e_list) (assoc 51 e_list)
                            (assoc 7 e_list) (assoc 71 e_list) 
                            (assoc 72 e_list) (assoc 11 e_list)
                            (assoc 210 e_list) '(73 . 0))
         )
         (entmake e_list)
         (setq sub_ent (entnext sub_ent))
      )

      ; Shift the LINE in PISTAKE block to layer F977
      (command "explode" main_ent)
      (setq e_line (entlast) e_list (entget e_line)
            e_list (subst (cons 8 "F977") (assoc 8 e_list) e_list)
      )
      (entmod e_list)
      (entdel e_line)

      ; Delete the ATTDEFs of EXPLODED PISTAKE
      (setq sub_ent (entlast))
      (while (eq "ATTDEF" (cdr (assoc 0 (entget sub_ent))))
         (entdel (entlast))
         (setq sub_ent (entlast))
      )
      
      (entdel e_line) ; Undeletes the LINE in PISTAKE
   )); endif (eq "INSERT" (cdr (assoc 0 e_list)))
)
; ---------------------------------------------------------------------------
(Defun LOOKFILE (fname / fptr STA_Type)
   (if (not (findfile fname))

      (Run_Err (strcat "Error accessing file : " fname))

      (Progn
         (setq STA_Type "" 
               Ftr_Code "63" 
               fptr     (open fname "r")
         )

         (while (and (/= STA_Type "PI") (/= STA_Type "AP")) 
                     (setq inline (read-line fptr))
                     (Assign_Fld)
                     (setq STA_Type (substr STA_Name 1 2))
         )
         (close fptr)
         (setq Ftr_Code   (if (eq STA_Type "AP") "73" Ftr_Code) 
               Ftr_Layer  (strcat "F" Ftr_Code)
               Text_Layer "Text"               
               ;Text_Layer (strcat "T" Ftr_Code)
         )
      )
   )
)
; ---------------------------------------------------------------------------
; Draw stake circles
(Defun STA_CIR (C_Pt) 
   (setvar "clayer" "F665")
   (command "circle" C_Pt (* scl 0.001))
)
; -------------------------- end Sub-routines-----------------------------

; Draw Centreline from PI to PI & write START/PI/END points to a file
(Defun CEN_LINE (fname / fptr)
   (Define_E)
   (LOOKFILE fname)
  
   (princ "\nDrawing the Route Centreline, please wait ...")
   (setq fptr (open fname "r"))
   (setq From nil)
   (setvar "plinetype" 0)
   (command "layer" "M" Ftr_Layer "C" 210 Ftr_Layer "" "pline")
   (while (setq inline (read-line fptr))
      (Assign_Fld)  
      (command Stake_XY)
   )
   (command)
   (close fptr)
   (Restor_E)
); -------------------------- end (CEN_LINE) ------------------------------

(Defun KM_TICK (/ E_List E_name Route_Length plist Vertices ver_no first_pt ver_list)
    (c:elimits)                     ; (c:elimits) is a separately-defined routine  
    (setq E_List (entget (entlast)))
    (if (member (setq E_name (cdr (assoc 0 E_List))) (list "LWPOLYLINE" "POLYLINE")) (Progn
       (setq Route_Length 0.0
             plist        (Get_Poly (entlast)) ; Get_Poly is a routine defined in SM.MNL
             Vertices     (length plist)
             ver_no       0
             first_pt     (nth ver_no plist)
       )
       (while (< ver_no Vertices)
          (setq ver_list      (nth ver_no plist)
                ver_no        (1+ ver_no)
                Route_Length  (+ Route_Length (distance first_pt ver_list))
                first_pt      ver_list
          )
       );endwhile
   ))

   (princ (strcat "\nLength of the Route is " (rtos Route_Length 2 2) " Km.\n"))


   (if (> Route_Length 1000.00) (Progn

      (if (not (tblsearch "BLOCK" "KM-TICK"))
         (if (not (findfile "KM-TICK.DWG"))
            (KM_Err "Can't find block KM-TICK in ACAD environment")
            (Progn (command "insert" "KM-TICK" '(0 0 0) 1.0 1.0 0.0)
                   (if (= "KM-TICK" (cdr (assoc 2 (entget (entlast)))))
                      (entdel (entlast))
                   );endif
            );end Progn
         );endif
      );endif   

      (if (not (tblsearch "LAYER" "F962")) (command "layer" "N" "F962" ""))
         (command "layer" "M" "F962" "M" "F963" "off" "*" "N" "ON" Ftr_Layer ""
                  "undo" "g"
                  "measure" (cdr (assoc 10 (entget (entnext (entlast))))) "block" "KM-TICK" "Y" 1000.0
      )

      (cond ((not (setq s_set (ssget "p"))) 
                  (princ "\nNo insertions created."))
            (t (if (not Km_No) (setq Km_No 1)) ; else value of Km_No is what is globally defined. 
               (Repeat (sslength s_set)
                  (setq e_list (entget (ssname s_set 0))
                        e_list (subst (cons 41 blksf) (assoc 41 e_list) e_list)
                        e_list (subst (cons 42 blksf) (assoc 42 e_list) e_list)
                        e_list (subst (cons 43 blksf) (assoc 43 e_list) e_list)
                  )      
                  (entmod e_list)
                  (command "text" (cdr (assoc 10 e_list)) (* ptxtht 2) 0 (itoa Km_No))
                  (setq s_set  (ssdel (ssname s_set 0) s_set)
                        Km_No (1+ Km_No)
                        e_list (entget (entlast))
                        e_list (subst (cons 8 "F962") (assoc 8 e_list) e_list)
                  )
                  (entmod e_list)
               );end Repeat
            )
      )
      (command "layer" "on" "*" "" "undo" "e")
   )); endif & Progn (> Route_Length 1000.00)
); -------------------------- end (KM_TICK) ------------------------------

; Calculate and annotate bearing from PI to PI
(Defun BEARING (fname / fptr p1 p2 p3 Brg1 midpt angp Brg deg minutes dst lstrt lend)
   (Define_E)
   (LOOKFILE fname)
   (SetUnits)
   (princ "\nAnnotating bearings, please wait ...")
   (command "layer" "M" Text_Layer "")
   (setq fptr   (open fname "r") 
         inline (read-line fptr)
   )
   (Assign_Fld)  
   (setq p1     Stake_XY
         inline (read-line fptr)
   )
       
   (while inline
      (Assign_Fld)

      (if (or (eq (substr STA_Name 1 5) "START")
              (eq (substr STA_Name 1 4) "END ")
              (eq (substr STA_Name 1 2) "PI")
              (eq (substr STA_Name 1 2) "AP")) (Progn 
         (setq p2     Stake_XY
               Brg1   (angle p1 p2)
               midpt  (polar p1 Brg1 (/ (distance p1 p2) 2))
               angp   (+ Brg1 (DTR 90))
               p3     (polar midpt angp ptxtht)
               Brg    (angtos Brg1 1 2)
         )

         (cond ((>= (atoi Brg) 100)
                  (setq deg (substr Brg 1 3) minutes (substr Brg 5)))
               ((>= (atoi Brg) 10)
                  (setq deg (substr Brg 1 2) minutes (substr Brg 4)))
               (t (setq deg (substr Brg 1 1) minutes (substr Brg 3)))

         )

         (setq deg     (if (eq (strlen deg) 1) (strcat "0" deg) deg)
               deg     (if (eq (strlen deg) 2) (strcat "0" deg) deg)
               minutes (if (eq (strlen minutes) 2) (strcat "0" minutes) minutes)
               Brg     (strcat deg "%%d" minutes )
               ndst    (* (strlen Brg) ptxtht)
               lstrt   (polar p3 Brg1 (* ndst 0.75))
               lend    (polar p3 Brg1 (* ndst 0.40))
         )
         
         (command "text" "m" p3 ptxtht (angtos Brg1 1 4) Brg
                  "dim1" "lea" lstrt lend "" ""
         )

         (if (eq "MTEXT" (cdr (assoc 0 (entget (entlast)))))
            (entdel (entlast))
         )

         (if (eq "LINE" (cdr (assoc 0 (entget (entlast))))) (Progn
            (if (/= (cadr (assoc 11 (entget (entlast)))) (car lend))
               (entdel (entlast))
            )
         ))

         (setq p1 p2) 
      ))
      (setq inline (read-line fptr))
   )
   (close fptr)
   (ResUnits)
   (Restor_E)
); -------------------------- end (BEARING) ------------------------------ 

; Insert block STAKE. STAKE points do not include START, END & PI points
(Defun STAKE (fname / fptr p1 p2 Rot_Pt e_list)

   (Define_E)
   (LOOKFILE fname)
  
   (SetUnits)
   (princ "\nInserting STAKES, please wait ...")
   (command "layer" "M" "F665" "M" "F977" "")
   (setq fptr   (open fname "r")
         inline (read-line fptr)
   )
   (Assign_Fld)  
   (setq p1 Stake_XY)
 
   (while (setq inline (read-line fptr))
      (Assign_Fld)
     
      (if (and (/= (substr STA_Name 1 3) "STA") (/= (substr STA_Name 1 3) "OHL"))

         (if (or (eq (substr STA_Name 1 2) "PI") (eq (substr STA_Name 1 2) "AP"))
            (setq p1 Stake_XY)
         )

         (Progn   ; else
            (setq p2     Stake_XY
                  Rot_Pt (polar p2 (- (angle p1 p2) 1.5707963) (* scl 0.0235))
            )
            (STA_CIR p2)
            (setvar "clayer" "F977")
            (command "insert" "*stake" p2 blksf Rot_Pt)
            (setq e_list (entget (entlast))
                  e_list (subst (cons 1 STA_Name) (assoc 1 e_list) e_list)
            )
            (entmod e_list)
         )
      );endif (/= (substr STA_Name 1 3) "STA")
   )
   (close fptr)
   (ResUnits)
   (Restor_E)
); ---------------------------- end (STAKE) ------------------------------
; Insert block PISTAKE for START, END and PI stakes.
(Defun PISTAKE (fname / CPI_Pt PPI_Pt NPI_Pt Ang B1 B2 inc_ang Deg Min Sec
                        Minu_R Sec_R)
   (Define_E)
   (LOOKFILE fname)
   (SetUnits)
   (princ "\nInserting PI Stakes, please wait ...")
   (command "layer" "M" "F665" "M" "F977" "")
   (setq fptr     (open fname "r")
         inline   (read-line fptr)
   )
   (Assign_Fld)
   
   (setq C_STA    STA_Name
         C_STA    (if (eq "START" (substr C_STA 1 5)) (substr C_STA 7) C_STA)
         CPI_Pt   Stake_XY
         N_STA    nil
         ;out_file (strcat (substr fname 1 (- (strlen fname) 4)) ".DMS")
         ;fptr2    (open out_file "w")
   )

   (while (and (not N_STA) (setq inline (read-line fptr)))
      (Assign_Fld)
      
      (if (or (eq (substr STA_Name 1 2) "PI")
              (eq (substr STA_Name 1 2) "AP")
              (eq (substr STA_Name 1 4) "END "))
         (setq N_STA  STA_Name
               NPI_Pt Stake_XY
         )
      )
   )
   
   (INS_PI CPI_Pt NPI_Pt "START OF ROUTE" C_STA)
   ;(WL CPI_Pt "0000.0000" C_STA)
 
   (while (setq inline (read-line fptr))
      (Assign_Fld)

      (if (or (eq (substr STA_Name 1 2) "PI")
              (eq (substr STA_Name 1 2) "AP")
              (eq (substr STA_Name 1 4) "END ")) (Progn
         (setq PPI_Pt CPI_Pt
               CPI_Pt NPI_Pt 
               C_STA  N_STA
               N_STA  STA_Name
               N_STA  (if (eq "END" (substr N_STA 1 3)) (substr N_STA 5) N_STA)
               NPI_Pt Stake_XY
               Ang    (- (angle CPI_Pt NPI_Pt) (angle PPI_Pt CPI_Pt))
               B2     (angle CPI_Pt NPI_Pt)
               B1     (angle PPI_Pt CPI_Pt)
         )

         (if (< B1 pi) 
            (setq Turn (if (and (> B2 B1) (< B2 (+ B1 pi))) "L" "R"))
         )

         (if (> B1 pi)
            (setq Turn (if (and (< B2 B1) (> B2 (- B1 pi))) "R" "L"))
         )

         (setq inc_ang (abs (- B2 B1))
               Ang     (if (> pi inc_ang) (- (* 2 pi) inc_ang) Ang)
               DMS     (RTD Ang)
               DMS     (if (> 0.0 DMS) (+ 360.0 DMS) (- 360.0 DMS))
               Deg     (fix DMS)
               DMS     (* (- DMS Deg) 60.0)
               Minu    (fix DMS)
               DMS     (* (- DMS Minu) 60) 
               Sec     (fix DMS) 
               DMS     (* (- DMS Sec) 60) 
               Msec    (fix DMS)
               Sec     (if (>= Msec 30) (+ Sec 1) Sec)

         )
         (Cond ((>= Sec 30) (setq Minu (+ Minu 1) Sec 0)))
         (Cond ((= Minu 60) (setq Deg (+ Deg 1) Minu 0)))

         (setq Deg    (itoa Deg)
               Deg    (if (eq (strlen Deg) 1) (strcat "0" Deg) Deg)
               Deg    (if (eq (strlen Deg) 2) (strcat "0" Deg) Deg)
               Minu   (itoa Minu)
               Minu   (if (eq (strlen Minu) 1) (strcat "0" Minu) Minu)
               Sec    (itoa Sec)
               Sec    (if (eq (strlen Sec) 1) (strcat "0" Sec) Sec)
               Turn   (strcat Turn "T " Deg "%%d" Minu "'")
         )

         (INS_PI CPI_Pt NPI_Pt Turn C_STA)
         (WL CPI_Pt (strcat (substr Turn 1 1) Deg "." Minu Sec) C_STA)
      ))
   )

   (if (not PPI_Pt) (setq PPI_Pt CPI_Pt))
   (INS_PI NPI_Pt PPI_Pt "END OF ROUTE" N_STA)
   (WL NPI_Pt "0000.0000" N_STA)
   (close fptr)
   ;(close fptr2)
   (command "redraw")
   (ResUnits)
   (Restor_E)
); ---------------------------- end (PISTAKE) ------------------------------

; ------------------------------ Main Routine ------------------------------
(Defun C:STAKES_CSV ()
   (Define_E)

   ; Get filename of centreline STAKES & PIs
   (setq inline       nil
         Temp         nil
         P_Fld        nil
         F_Fld        nil
         X_Fld        nil
         Y_Fld        nil
         Z_Fld        nil
         Stake_XY     nil
         STA_Name     nil
         Route_Length nil
   )
   (setq fname (getfiled "Select a stakes data file to read in" "" "" 4))

   (LOOKFILE fname)
   (command ".undo" "g")
   (ResUnits)
   (CEN_LINE fname)
   (KM_TICK)
   (SetUnits)
   (BEARING fname)
   (STAKE fname)
   (PISTAKE fname)
   (command ".undo" "e")
   (ResUnits)
   (Restor_E)

); -------------------------- end STAKES_CSV.LSP --------------------------------


; ---------------------------------------------------------------------------

; Sub-routines
(Defun SetUnits () 
                (command "units" 2 4 1 4 0 "N")
                (command "units" 2 4 2 4 90 "Y")) ; Set UNITS to DMS
(Defun ResUnits () (command "units" 2 4 1 4 0 "N"))
(Defun DTR (D) (/ (* d pi) 180.0))   ; convert degrees to radians
(Defun RTD (R) (/ (* r 180.0) pi))   ; convert radians to degrees
;(Defun KM_Err (err_msg) (beep) (princ (strcat "\n" err_msg)))
(Defun KM_Err (err_msg) (beep) (alert err_msg))
(Defun Form_XY (p) 
   (setq p (read (strcat "(" p ")"))
         p (list (car p) (cadr p))
         p (if (> (car p) (cadr p)) (reverse p) p)
   )
)

(Defun WL (xy tang sta_name / x_str y_str ds ang_str)
   (setq x_str (rtos (car xy) 2 3) y_str (rtos (cadr xy) 2 3))
   (if (or (eq (ascii tang) 76) (eq (ascii tang) 82))
      (setq ds      (if (eq (ascii tang) 76) "L" "R")
            ang_str (substr tang 2)
            ang_str (cond ((eq (strlen ang_str) 7) (strcat "0" ang_str))
                          ((eq (strlen ang_str) 6) (strcat "00" ang_str))
                          (t ang_str))
      )
      (setq ds "" ang_str tang)
   )
   (write-line (strcat x_str " " y_str " " ds ang_str " " sta_name) fptr2)
)

(Defun RTRIM (s / c)
   (setq c (substr s (strlen s)))
   (while (or (eq c " ") (eq c ","))
      (setq s (substr s 1 (1- (strlen s))) c (substr s (strlen s))))
   (cond ((eq s "") nil) (t s))
)

(Defun INS_PI (I_Pt R_Pt T_Ang PI_No / X Y e_list main_ent sub_ent e_line)
   (setq X (rtos (car I_Pt) 2 2)
         Y  (rtos (cadr I_Pt) 2 2)
         X  (strcat (substr X 1 3) " " (substr X 4) " E")
         Y  (strcat (substr Y 1 1) " " (substr Y 2 3) " " (substr Y 5) " N")
   )
   (STA_CIR I_Pt)
   (setvar "clayer" "F977")
   (command "insert" "PISTAKE" I_Pt blksf blksf R_Pt X Y T_Ang PI_No)

   ; Replace the attributes in PISTAKE block with textual elements
   (setq e_list (entget (setq main_ent (entlast))))

   (if (and (eq "INSERT" (cdr (assoc 0 e_list)))
            (eq "PISTAKE" (cdr (assoc 2 e_list)))) (Progn
      (setq sub_ent (entnext main_ent))          
      (while (/= "SEQEND" (cdr (assoc 0 (setq e_list (entget sub_ent)))))
         (setq e_list (cdr e_list)
               e_list (subst (cons 0 "TEXT") (assoc 0 e_list) e_list)
               e_list (list (assoc 0 e_list) '(8 . "F977") 
                            (assoc 10 e_list) (assoc 40 e_list)
                            (assoc 1 e_list) (assoc 50 e_list)
                            (assoc 41 e_list) (assoc 51 e_list)
                            (assoc 7 e_list) (assoc 71 e_list) 
                            (assoc 72 e_list) (assoc 11 e_list)
                            (assoc 210 e_list) '(73 . 0))
         )
         (entmake e_list)
         (setq sub_ent (entnext sub_ent))
      )

      ; Shift the LINE in PISTAKE block to layer F977
      (command "explode" main_ent)
      (setq e_line (entlast) e_list (entget e_line)
            e_list (subst (cons 8 "F977") (assoc 8 e_list) e_list)
      )
      (entmod e_list)
      (entdel e_line)

      ; Delete the ATTDEFs of EXPLODED PISTAKE
      (setq sub_ent (entlast))
      (while (eq "ATTDEF" (cdr (assoc 0 (entget sub_ent))))
         (entdel (entlast))
         (setq sub_ent (entlast))
      )
      
      (entdel e_line) ; Undeletes the LINE in PISTAKE
   )); endif (eq "INSERT" (cdr (assoc 0 e_list)))
)

(Defun LOOKFILE (fname / fptr record STA_Type)
   (if (not (findfile fname))

      (Run_Err (strcat "Error accessing file : " fname))

      (Progn
         (setq STA_Type "" 
               Ftr_Code "63" 
               fptr     (open fname "r")
         )

         (while (and (/= STA_Type "PI") (/= STA_Type "AP") 
                     (setq record (read-line fptr)))
            (setq STA_Type (substr record 24 2))
         )
         (close fptr)
         (setq Ftr_Code   (if (eq STA_Type "AP") "73" Ftr_Code) 
               Ftr_Layer  (strcat "F" Ftr_Code)
               Text_Layer (strcat "T" Ftr_Code)
         )
      )
   )
)

; Draw stake circles
(Defun STA_CIR (C_Pt) 
   (setvar "clayer" "F665")
   (command "circle" C_Pt (* scl 0.001))
)
; -------------------------- end Sub-routines-----------------------------
(Defun KM_TICK (fname / s_set s_set2 e_list Km_No)
   (Define_E)
   (LOOKFILE fname)

   (if (tblsearch "LAYER" Ftr_Layer) (Progn
      (setq s_set (ssget "X" (list (cons 0 "POLYLINE")
                                   (cons 8 Ftr_Layer))))
      (if (not s_set)
         (KM_Err (strcat "Can't find a route polyline on " Ftr_Layer))
      )
   ))

   (if (and s_set (> (sslength s_set) 1)) (Progn
      (KM_Err (strcat "Multiple route polylines on " Ftr_Layer))
      (setq s_set nil)
   ))

   (if s_set 
      (setq s_set2 s_set
            s_set (cdr (assoc 10 (entget (entnext (ssname s_set 0))))))
   )

   (if (not s_set) (Progn
      (setq s_set (entsel "\nPick the centreline polyline ..."))
      (if s_set (setq s_set2 (car s_set)))
   ))

   (if (not s_set) (Run_Err "Centreline polyline not picked ..."))
   
   (if s_set (Progn

      (if (not (tblsearch "BLOCK" "KM-TICK"))
         (if (not (findfile "KM-TICK.DWG"))
            (KM_Err "Can't find block KM-TICK in ACAD environment")
            (Progn (command "insert" "KM-TICK" '(0 0 0) 1.0 1.0 0.0)
                   (if (= "KM-TICK" (cdr (assoc 2 (entget (entlast)))))
                      (entdel (entlast))
            ))
      ))   

      (if (not (tblsearch "LAYER" "F962")) (command "layer" "N" "F962" ""))
      (if (not (tblsearch "LAYER" "P999")) (command "layer" "N" "P999" ""))
      (command "layer" "M" "F962" "M" "F963" "off" "*" "N" "ON" Ftr_Layer "")
      (command "undo" "g" "measure" s_set "block" "KM-TICK" "Y" 1000.0)

      (cond ((not (setq s_set (ssget "p"))) 
                  (princ "\nNo insertions created."))
            (t (setq Km_No 1)
               (Repeat (sslength s_set)
                  (setq e_list (entget (ssname s_set 0))
                        e_list (subst (cons 41 blksf) (assoc 41 e_list) e_list)
                        e_list (subst (cons 42 blksf) (assoc 42 e_list) e_list)
                        e_list (subst (cons 43 blksf) (assoc 43 e_list) e_list)
                  )      
                  (entmod e_list)
                  (command "text" (cdr (assoc 10 e_list)) (* ptxtht 2) 0 (itoa Km_No))
                  (setq s_set  (ssdel (ssname s_set 0) s_set)
                        Km_No (1+ Km_No)
                        e_list (entget (entlast))
                        e_list (subst (cons 8 "F962") (assoc 8 e_list) e_list)
                  )
                  (entmod e_list)
               );end Repeat
            )
      )
      (command "chprop" s_set2 "" "LAyer" "P999" "" "layer" "on" "*" "")
      (command "undo" "e")
   ))
   (Restor_E)
); -------------------------- end (KM_TICK) ------------------------------
; Draw Centreline from PI to PI & write START/PI/END points to a file
(Defun CEN_LINE (fname / fptr record STA_Name)
   (Define_E)
   (LOOKFILE fname)
  
   (princ "\nDrawing the Route Centreline, please wait ...")
   (setq fptr (open fname "r"))
   (command "layer" "M" Ftr_Layer "C" 210 Ftr_Layer "" "pline")
   (while (setq record (read-line fptr))
      (setq STA_Name (substr record 24))
      ;(if (or (eq (substr STA_Name 1 5) "START") 
      ;        (eq (substr STA_Name 1 4) "END ")
      ;        (eq (substr STA_Name 1 2) "PI")
      ;         (eq (substr STA_Name 1 2) "AP"))
         (command (Form_XY record))
      ;)
   )
   (command)
   (close fptr)
   (Restor_E)
); -------------------------- end (CEN_LINE) ------------------------------
; Calculate and annotate bearing from PI to PI
(Defun BEARING (fname / fptr record STA_Name p1 p2 p3 Brg1 midpt angp Brg 
                 deg minutes dst lstrt lend)
   (Define_E)
   (LOOKFILE fname)

   (SetUnits)
   (princ "\nAnnotating bearings, please wait ...")
   (command "layer" "M" Text_Layer "")
   (setq fptr   (open fname "r") 
         p1     (Form_XY (read-line fptr))
         record (read-line fptr)
   ) 

   (while record
      (setq STA_Name (substr record 24))

      (if (or (eq (substr STA_Name 1 5) "START")
              (eq (substr STA_Name 1 4) "END ")
              (eq (substr STA_Name 1 2) "PI")
              (eq (substr STA_Name 1 2) "AP")) (Progn 
         (setq p2     (Form_XY record)
               Brg1   (angle p1 p2)
               midpt  (polar p1 Brg1 (/ (distance p1 p2) 2))
               angp   (+ Brg1 (DTR 90))
               p3     (polar midpt angp ptxtht)
               Brg    (angtos Brg1 1 2)
         )

         (cond ((>= (atoi Brg) 100)
                  (setq deg (substr Brg 1 3) minutes (substr Brg 5)))
               ((>= (atoi Brg) 10)
                  (setq deg (substr Brg 1 2) minutes (substr Brg 4)))
               (t (setq deg (substr Brg 1 1) minutes (substr Brg 3)))

         )

         (setq Brg   (strcat deg "%%d" minutes )
               ndst  (* (strlen Brg) ptxtht)
               lstrt (polar p3 Brg1 (* ndst 0.75))
               lend  (polar p3 Brg1 (* ndst 0.40))

         )
         
         (command "text" "m" p3 ptxtht (angtos Brg1 1 4) Brg
                  "dim1" "lea" lstrt lend "" ""
         )

         (if (eq "MTEXT" (cdr (assoc 0 (entget (entlast)))))
            (entdel (entlast))
         )

         (if (eq "LINE" (cdr (assoc 0 (entget (entlast))))) (Progn
            (if (/= (cadr (assoc 11 (entget (entlast)))) (car lend))
               (entdel (entlast))
            )
         ))

         (setq p1 p2) 
      ))
      (setq record (read-line fptr))
   )
   (close fptr)
   (ResUnits)
   (Restor_E)
); -------------------------- end (BEARING) ------------------------------ 

; Insert block STAKE. STAKE points do not include START, END & PI points
(Defun STAKE (fname / fptr record STA_Name p1 p2 Rot_Pt e_list)

   (Define_E)
   (LOOKFILE fname)
  
   (SetUnits)
   (princ "\nInserting STAKES, please wait ...")
   (command "layer" "M" "F665" "M" "F977" "")
   (setq fptr (open fname "r") p1 (Form_XY (read-line fptr)))

   (while (setq record (read-line fptr))
      (setq STA_Name (substr record 24))

      (if (and (/= (substr STA_Name 1 3) "STA") (/= (substr STA_Name 1 3) "OHL"))

         (if (or (eq (substr STA_Name 1 2) "PI") (eq (substr STA_Name 1 2) "AP"))
            (setq p1 (Form_XY record))
         )

         (Progn   ; else
            (setq STA_Name (RTRIM STA_Name)
                  p2     (Form_XY record)
                  Rot_Pt (polar p2 (- (angle p1 p2) 1.5707963) (* scl 0.0235))
            )
            (STA_CIR p2)
            (setvar "clayer" "F977")
            (command "insert" "*stake" p2 blksf Rot_Pt)
            (setq e_list (entget (entlast))
                  e_list (subst (cons 1 STA_Name) (assoc 1 e_list) e_list)
            )
            (entmod e_list)
         )
      );endif (/= (substr STA_Name 1 3) "STA")
   )
   (close fptr)
   (ResUnits)
   (Restor_E)
); ---------------------------- end (STAKE) ------------------------------
; Insert block PISTAKE for START, END and PI stakes.
(Defun PISTAKE (fname / CPI_Pt PPI_Pt NPI_Pt Ang B1 B2 inc_ang Deg Min Sec
                        Minu_R Sec_R)
   (Define_E)
   (LOOKFILE fname)
   (SetUnits)
   (princ "\nInserting PI Stakes, please wait ...")
   (command "layer" "M" "F665" "M" "F977" "")
   (setq fptr     (open fname "r")
         record   (read-line fptr)
         C_STA    (RTRIM (substr record 24))
         C_STA    (if (eq "START" (substr C_STA 1 5)) (substr C_STA 7) C_STA)
         CPI_Pt   (Form_XY record)
         N_STA    nil
         ;out_file (strcat (substr fname 1 (- (strlen fname) 4)) ".DMS")
         ;fptr2    (open out_file "w")
   )

   (while (and (not N_STA) (setq record (read-line fptr)))
      (setq STA_Name (substr record 24))

      (if (or (eq (substr STA_Name 1 2) "PI")
              (eq (substr STA_Name 1 2) "AP")
              (eq (substr STA_Name 1 4) "END "))
         (setq N_STA (RTRIM (substr record 24)) NPI_Pt (Form_XY record))
      )
   )
   
   (INS_PI CPI_Pt NPI_Pt "START" C_STA)
   ;(WL CPI_Pt "0000.0000" C_STA)
 
   (while (setq record (read-line fptr))
      (setq STA_Name (substr record 24))

      (if (or (eq (substr STA_Name 1 2) "PI")
              (eq (substr STA_Name 1 2) "AP")
              (eq (substr STA_Name 1 4) "END ")) (Progn
         (setq PPI_Pt CPI_Pt
               CPI_Pt NPI_Pt 
               C_STA  N_STA
               N_STA  (RTRIM STA_Name)
               N_STA  (if (eq "END" (substr N_STA 1 3)) (substr N_STA 5) N_STA)
               NPI_Pt (Form_XY record)
               Ang    (- (angle CPI_Pt NPI_Pt) (angle PPI_Pt CPI_Pt))
               B2     (angle CPI_Pt NPI_Pt)
               B1     (angle PPI_Pt CPI_Pt)
         )

         (if (< B1 pi) 
            (setq Turn (if (and (> B2 B1) (< B2 (+ B1 pi))) "L" "R"))
         )

         (if (> B1 pi)
            (setq Turn (if (and (< B2 B1) (> B2 (- B1 pi))) "R" "L"))
         )

         (setq inc_ang (abs (- B2 B1))
               Ang     (if (> pi inc_ang) (- (* 2 pi) inc_ang) Ang)
               DMS     (RTD Ang)
               DMS     (if (> 0.0 DMS) (+ 360.0 DMS) (- 360.0 DMS))
               Deg     (fix DMS)
               DMS     (* (- DMS Deg) 60.0)
               Minu    (fix DMS)
               DMS     (* (- DMS Minu) 60) 
               Sec     (fix DMS) 
               DMS     (* (- DMS Sec) 60) 
               Msec    (fix DMS)
               Sec     (if (>= Msec 30) (+ Sec 1) Sec)

         )
         (Cond ((>= Sec 30) (setq Minu (+ Minu 1) Sec 0)))
         (Cond ((= Minu 60) (setq Deg (+ Deg 1) Minu 0)))

         (setq Deg    (itoa Deg)
               Deg    (if (eq (strlen Deg) 1) (strcat "0" Deg) Deg)
               Deg    (if (eq (strlen Deg) 2) (strcat "0" Deg) Deg)
               Minu   (itoa Minu)
               Minu   (if (eq (strlen Minu) 1) (strcat "0" Minu) Minu)
               Sec    (itoa Sec)
               Sec    (if (eq (strlen Sec) 1) (strcat "0" Sec) Sec)
               Turn   (strcat Turn "T " Deg "%%d" Minu "'")
         )

         (INS_PI CPI_Pt NPI_Pt Turn C_STA)
         ;(WL CPI_Pt (strcat (substr Turn 1 1) Deg "." Minu Sec) C_STA)
      ))
   )

   (if (not PPI_Pt) (setq PPI_Pt CPI_Pt))
   (INS_PI NPI_Pt PPI_Pt "END" N_STA)
   ;(WL NPI_Pt "0000.0000" N_STA)
   (close fptr)
   ;(close fptr2)
   (command "redraw")
   (ResUnits)
   (Restor_E)
); ---------------------------- end (PISTAKE) ------------------------------

; ------------------------------ Main Routine ------------------------------
(Defun C:STAKES ()
   (Define_E)

   ; Get filename of centreline STAKES & PIs
   (setq fname (getfiled "Select a stakes data file to read in" "" "" 4))

   (LOOKFILE fname)
   (command ".undo" "g")
   (ResUnits)
   (KM_TICK fname)
   (CEN_LINE fname) 
   (SetUnits)
   (BEARING fname)
   (STAKE fname)
   (PISTAKE fname)
   (command ".undo" "e")
   (ResUnits)
   (Restor_E)

); -------------------------- end STAKES.LSP --------------------------------


[cadffm]

Where is your ATTDIA handling? Where is your ATTREQ handling?

[Hannan1]

Here,

;;; Oldatts sets "old_al" (OLD_Attribute_List) to the list of old Attributes
;;; for each Block.  The list does not include constant Attributes.
;;;
(defun oldatts (/ e_name e_list cont)
  (setq oa_ctr 0 
        cont   T
        e_name b1
  )
  (while cont
    (if (setq e_name (entnext e_name))
      (progn
        (setq e_list (entget e_name))
        (if (and (= (cdr (assoc 0 e_list)) "ATTRIB")
                 ;; NOT a constant attribute -- (cdr (assoc 70 e_list)) != 2)
                 (/= (logand (cdr (assoc 70 e_list)) 2) 2))
          (progn
            (if old_al
              (setq old_al (cons e_list old_al))
              (setq old_al (list e_list))
            )
            (setq oa_ctr (1+ oa_ctr))           ; count the number of old atts
          )
          ;; else, exit
          (setq cont nil)
        )
      )
      (setq cont nil)
    )
  )
)
;;;
;;; Newatts sets "new_al" to the list of new Attributes in the new Block.
;;; The list does not include constant Attributes.
;;;
(defun newatts (ssetn ssl / i e_name e_list)
  (setq i 0 na_ctr 0)
  (while (< i ssl)
    (if (setq e_name (ssname ssetn i))
      (progn
        (setq e_list (entget e_name))
        (if (and (= (cdr (assoc 0 e_list)) "ATTDEF")
                 ;; NOT a constant attribute -- (cdr (assoc 70 e_list)) != 2)
                 (/= (logand (cdr (assoc 70 e_list)) 2) 2))
          (progn
            (if new_al
              (setq new_al (cons e_list new_al))
              (setq new_al (list e_list))
            )
            (setq na_ctr (1+ na_ctr))     ; count the number of new atts
          )
        )
      )
    )
    (setq i (1+ i))
  )
  na_ctr
)
;;;
;;; Compare the list of "old" to the list of "new" Attributes and make
;;; the two lists "same" and "preset". "Same" contains the old values of
;;; all the Attributes in "old" with equal tag values to some Attribute
;;; in "new" and the default values of all the other Attributes. "Preset"
;;; contains the preset Attributes in old with equal tag values to some
;;; Attribute in new.
;;;
(defun compare (/ i j)
  (setq i 0
        j 0
        pa_ctr 0
        same nil
        va_ctr 0
        preset nil)
  ;; "i" is a counter that increments until the number of new attributes
  ;; is reached.
  (while (< i na_ctr)
    (cond 
      ;; If there are old attributes AND the tag strings of the old and new 
      ;; attributes are the same...
      ((and old_al
            (= (cdr (assoc 2 (nth j old_al))) (cdr (assoc 2 (nth i new_al)))))
        ;; IS a preset attribute -- (cdr (assoc 70 e_list)) == 8)
        (if (= (logand (cdr (assoc 70 (nth i new_al))) 😎 8)
          ;; If the attribute is a preset attribute then add it to the list
          ;; of preset attributes and increment the counter "pa_ctr".
          ;; IS a preset attribute -- (cdr (assoc 70 e_list)) == 8)
          (progn
            (if preset
              (setq preset (cons (nth j old_al) preset))
              (setq preset (list (nth j old_al)))
            )
            (setq pa_ctr (1+ pa_ctr))     ; count preset atts
          )
          ;; Else, add it to the list of same attributes "same".
          (if same
            (setq same (cons (cdr (assoc 1 (nth j old_al))) same))
            (setq same (list (cdr (assoc 1 (nth j old_al)))))
          )
        )
        ;; If the attribute must be verified, increment counter "va_ctr".
        ;; NOT a preset attribute -- (cdr (assoc 70 e_list)) != 8)
        (if (and (/= (logand (cdr (assoc 70 (nth i new_al))) 😎 8)
                 ;; IS a verified attribute -- (cdr (assoc 70 e_list)) == 4)
                 (= (logand (cdr (assoc 70 (nth i new_al))) 4) 4))
          (setq va_ctr (+ 1 va_ctr))
        )
        (setq i (1+ i))
        (setq j 0)
      )
      ;; If the number of old attributes equals the old attribute counter "j"
      ((= j oa_ctr)
        ;; If this attribute is not a preset attribute, but is not in the 
        ;; old list, then add it to the list "same".
        ;; NOT a preset attribute -- (cdr (assoc 70 e_list)) != 8)
        (if (/= (logand (cdr (assoc 70 (nth i new_al))) 😎 8)
          (if same
            (setq same (cons (cdr (assoc 1 (nth i new_al))) same))
            (setq same (list (cdr (assoc 1 (nth i new_al)))))
          )
        )
        ;; NOT a preset attribute -- (cdr (assoc 70 e_list)) != 8)
        (if (and (/= (logand (cdr (assoc 70 (nth i new_al))) 😎 8)
                 ;; IS a verified attribute -- (cdr (assoc 70 e_list)) == 4)
                 (= (logand (cdr (assoc 70 (nth i new_al))) 4) 4))
          (setq va_ctr (+ 1 va_ctr))
        )
        (setq i (1+ i))
        (setq j 0)
      )
      ;; Increment the old attribute counter "j"...
      (t
        (setq j (1+ j))
      )
    )
  )
)
;;;
;;; Find the entity for each of the "preset" Attributes in the newly
;;; inserted Block.
;;;
(defun findpt ()
  (setq test T)
  (setq en (entnext e1))
  (setq e_list (entget en))
  (while test
    (if (and (= (cdr (assoc 0 e_list)) "ATTRIB") (= (cdr (assoc 2 e_list)) tag))
      (setq test nil)
      (progn
        (setq ex en)
        (setq en (entnext ex))
        (if e_list
          (setq e_list (entget en))
        )
      )
    )
  )
)
;;;
;;; Insert a new Block on top of each old Block and set its new Attributes
;;; to their values in the list "same". Then replace each of the "preset"
;;; Attributes with its old value.
;;;
(defun redef (/ xsf ysf zsf ls i e1 v)
  (command "_.UCS" "_E" b1)         ; define the block's UCS
  (setq xsf (cdr (assoc 41 (entget b1)))) ; find x scale factor
  (setq ysf (cdr (assoc 42 (entget b1)))) ; find y scale factor
  (setq zsf (cdr (assoc 43 (entget b1)))) ; find z scale factor
  (setq ls (length same))
  (setq i 0)
  (command "_.INSERT" bn "0.0,0.0,0.0" "_XYZ" xsf ysf zsf "0.0")
  (while (< i ls)                     ; set attributes to their values
    (command (nth i same))
    (setq i (1+ i))
  )
  (while (< 0 va_ctr)
    (command "")                      ; at prompts, verify attributes
    (setq va_ctr (1- va_ctr))
  )
  (setq i 0)
  (setq e1 (entlast))
  (while (< 0 pa_ctr)                    ; edit each of the "preset" attributes
    (setq tag (cdr (assoc 2 (nth i preset))))
    (setq v (cdr (assoc 1 (nth i preset))))
    (findpt)                          ; find the entity to modify
    (setq e_list (subst (cons 1 v) (assoc 1 e_list) e_list))
    (entmod e_list)                        ; modify the entity's value
    (setq i (1+ i))
    (setq pa_ctr (1- pa_ctr))
  )
  (command "_.UCS" "_P")                 ; restore the previous UCS
)
;;;
;;; System variable save
;;;
(defun modes (a)
  (setq mlst '())
  (repeat (length a)
    (setq mlst (append mlst (list (list (car a) (getvar (car a))))))
    (setq a (cdr a)))
)
;;;
;;; System variable restore
;;;
(defun moder ()
  (repeat (length mlst)
    (setvar (caar mlst) (cadar mlst))
    (setq mlst (cdr mlst))
  )
)
;;;
;;; Internal error handler
;;;
(defun attrerr (s)                    ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (moder)                             ; restore saved modes
  (setq *error* olderr)               ; restore old *error* handler
  (princ)
)
;;;
;;; Main program
;;;
(defun C:ATTREDEF (/ k n olderr bn sseto ssetn pt ssl new_al
                     old_al same preset b1 oa_ctr va_ctr na_ctr
                  ) 
  (setq k 0
      n 0
      test T
      olderr *error*
      *error* attrerr
  )

  (modes '("CMDECHO" "ATTDIA" "ATTREQ" "GRIDMODE" "UCSFOLLOW"))
  (setvar "cmdecho" 0)                ; turn cmdecho off
  (setvar "attdia" 0)                 ; turn attdia off
  (setvar "attreq" 1)                 ; turn attreq on
  (setvar "gridmode" 0)               ; turn gridmode off
  (setvar "ucsfollow" 0)              ; turn ucsfollow off

  (while 
    (progn
      (setq bn (strcase (getstring 
        "\nName of Block you wish to redefine: ")))
      (if (tblsearch "block" bn)
        (progn
          (setq sseto (ssget "x" (list (cons 2 bn))))
          (setq test nil)
        )
        (progn
          (princ "\nBlock ")
          (princ bn)
          (princ " is not defined. Please try again.\n")
        )
       )
    )
  )
  (if sseto
    (progn
      (while 
        (progn
          (princ "\nSelect entities for new Block... ")
          (if (null (setq ssetn (ssget)))
            (princ "\nNo new Block selected. Please try again.")
            (setq test nil)
          )
        )
      )
      ;; find the list of new attributes
      (setq na_ctr (newatts ssetn (sslength ssetn)) )
      (if (> na_ctr 0)
        (progn
          (initget 1)
          (setq pt (getpoint "\nInsertion base point of new Block: "))
          (setq ssl (sslength sseto))
          ;; redefine the block
          (command "_.BLOCK" bn "_Y" pt ssetn "") 
          (while (< k ssl)
            (setq b1 (ssname sseto k))    ; For each old block...
            (setq old_al nil)
            (oldatts)                     ; find the list of old attributes,
            (compare)                     ; compare the old list with the new,
            (redef)                       ; and redefine its attributes.
            (entdel b1)                   ; delete the old block.
            (setq k (1+ k))
          )
          (command "_.REGENALL")
        )
        (princ "\nNew block has no attributes. ")
      )
    )
    (princ (strcat "\nNo insertions of block " bn " found to redefine. "))
  )
  (moder)                             ; restore saved modes
  (setq *error* olderr)               ; restore old *error* handler
  (princ)
)

(defun c:at () (c:attredef))
(princ 
  "\n\tC:ATtredef loaded.  Start command with AT or ATTREDEF.")
(princ)

[Hannan1]

When i check with VILDE Editor tool,

I have get results, (....................; warning: redefinition of built-in symbol: MIN.; Check done.)  

When i double click to that, it was selecting below code,

; Insert block PISTAKE for START, END and PI stakes.
(Defun PISTAKE (fname / CPI_Pt PPI_Pt NPI_Pt Ang B1 B2 inc_ang Deg Min Sec
                        Minu_R Sec_R)

What was have been changed in new versions with this code. 

[ВeekeeCZ]

---

@Hannan1 wrote:

When i check with VILDE Editor tool,

I have get results, (....................; warning: redefinition of built-in symbol: MIN.; Check done.)  

When i double click to that, it was selecting below code,

; Insert block PISTAKE for START, END and PI stakes.
(Defun PISTAKE (fname / CPI_Pt PPI_Pt NPI_Pt Ang B1 B2 inc_ang Deg Min Sec
                        Minu_R Sec_R)

What was have been changed in new versions with this code. 

---

Find all instances of 'min' being a single word and replace it with let's say 'mins'

Edit: Acually, this was partialy already done in the past... 'min' was replaced with 'minu' but 2 instances still remains min. So do the same.

But don't thnk this solves your trouble. You'll see.

[Hannan1]

Thanks for your reply,

I have replaced in all files but still same results found, As shown above screenshot.

[ВeekeeCZ]

It seems that the site broke the code. I got "malformed list on input" when trying to load. Possibly it's an issue with 😎 being recognized as a smile.

Post all that is needed to be able to run the code. Post it as *.lsp file.

Post some test drawing with a clear description of what it should do, what it does wrong now. And how to use it.

We need to be able to test your code and replicate the issue.

[Hannan1]

Here it is.