[编程交流] Lisp来放置文本-做什么

;;--------------------------------------------------------------------------
;; COORD.LSP                        PLACE CO-ORDINATE TEXT OF SELECTED POINT
;;==========================================================================
;;DESCRIPTION:  This routine will place co-ordinate text alongside a defined
;;              (user selected) point.  The `x' & `y' values of the selected
;;              point will be preceded with an `E' & `N' respectively. This
;;              routine also places a donut at the point.  The co-ord text is
;;              then echoed to the screen alongside the selected point, and
;;              the user is prompted to select the desired location of the
;;              text.  
;;
;;START COMMAND........   coord
;;
;;WRITTEN BY:   ALAN CULLEN           December 1994
;;
;;AMENDED:      August 1995           Error handler included
;;              November 1999         Modified to read text settings from
;;                                    configuration file "COORD.CFG"
;;              October 2007          Re-written for Tiger
;;
;;---------------------------ERROR HANDLER------------------------------
(defun clerr (s)
(if (/= s "Function cancelled")
  (if (= s "quit / exit abort")
    (princ)
    (princ (strcat "\nError: " s))
  )
)
(setvar "donutid" olid)
(setvar "donutod" olod)
(setvar "blipmode" olblip)
(setvar "LUPREC" oluprec)
;; (setvar "osmode" olsnap)
(setq el1 nil el2 nil)
(setvar "cmdecho" ocmd)
(setvar "ANGBASE" oangbase)       ;;Angle zero direction to "north"
(setvar "ANGDIR" oangdir)         ;;Clockwise angles
(setvar "dragmode" odrag)
(if olderr (setq *error* olderr))
(princ "\nERROR...CONSOLE BREAK...PREVIOUS DRAWING STATUS RESTORED...")
(princ)
)
;;-----------------------------MAIN PROGRAM------------------------------
(DEFUN C:cr  ()
(princ "\n PLACE POINT CO-ORDINATE TEXT  -  November  1999 - Alan CULLEN")
(setq txtang 90)                               ;;*** Set orientation angle for text (set for 0 deg = North, angles measured clockwise)
(setq lnspace 1.5)                            ;;*** Set text line spacing factor (generally 1.
(setq olderr *error* *error* clerr)        ;;Set new error handler
(setq ocmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq olid (getvar "DONUTID"))
(setvar "donutid" 0)
(setq olod (getvar "DONUTOD"))
(setvar "donutod" 300.0)                       ;;*** Sätter ytterdiameter på donut
(setq oluprec (getvar "LUPREC"))
(setvar "LUPREC" 3)                           ;;*** Sätter antal decimaler
;; (setq olsnap (getvar "osmode"))
(setq ts 5)                                   ;;*** Sätter text storlek
(setq olblip (getvar "blipmode"))
(setvar "blipmode" 0)                       ;;*** Set BLIPMODE enviroment variable 0/1 ... 0=OFF, 1=ON
(setq oangbase (getvar "ANGBASE"))
(setvar "ANGBASE" (/ pi 2))                   ;;Angle zero direction to "north"
(setq oangdir (getvar "ANGDIR"))
(setvar "ANGDIR" 1)                           ;;Clockwise angles
(setq odrag (getvar "dragmode"))
(setvar "dragmode" 2)
(setq pt T)
(while pt
 (princ "\n PLACE POINT CO-ORDINATE TEXT  -  November  1999 - Alan CULLEN")
 ;; (setvar "osmode" 1)
 (setq pt (getpoint "\n Välj Punkt - <RETURN> för att avsluta :"))                      
 ;; (setvar "osmode" 0)
 (if (/= pt nil)
  (progn
   (setq ptx (car pt) pty (cadr pt))
   (setq txtptx (/  ptx 1000))
   (setq txtptx (strcat "Y: " (rtos txtptx)))
   (setq txtpty (/  pty 1000))
   (setq txtpty (strcat "X: " (rtos txtpty)))
   (setq pt1 (list ptx pty 0))
   (setq txtpt1 (list ptx (+ pty (* lnspace ts)) 0))
   (command "doughnut" "" "" pt1 "")
   (command "text" txtpt1 ts txtang txtpty)
   (setq el1 (entlast))
   (command "text" pt1 ts txtang txtptx)
   (setq el2 (entlast))
   (prompt "\n     Välj Plats För Koordinattext ")
   (command "move" el1 el2 "" pt1 pause)
)))
(setvar "donutid" olid)
(setvar "donutod" olod)
(setvar "blipmode" olblip)
(setvar "LUPREC" oluprec)
;; (setvar "osmode" olsnap)
(setq el1 nil el2 nil)
(setq *error* olderr)             ;; Restore old error handler
(setvar "cmdecho" ocmd)
(setvar "ANGBASE" oangbase)
(setvar "ANGDIR" oangdir)
(setvar "dragmode" odrag)
(princ)
)

;WC.LSP is a programme to write coordinates. eldon Nov 1999
(defun C:WC (/ pt0 e east eastin n north northin)
;here begins the loop that gets the actual positions
  (while (setq pt0 (getpoint "\nPick co-ordinate point:  "))
         (setq e (car pt0)        ;easting coord as number
               n (cadr pt0)       ;northing coord as number
               east (rtos e 2 3)  ;easting coord as string
               north (rtos n 2 3)  ;northing coord as string
               eastin (strcat  east "mE" )
               northin (strcat  north "mN")
         )
  (command "TEXT" pt0 "0.1" "0" eastin);size of text changed manually
  (command "TEXT" "" northin)
   )
   (princ)
)

;WCMM.LSP is a programme to write coordinates in m when dwg units are mm. eldon Nov 1999
(defun C:WCmm (/ pt0 e east eastin n north northin)
;here begins the loop that gets the actual positions
  (while (setq pt0 (getpoint "\nPick co-ordinate point:  "))
         (setq e (car pt0)        ;easting coord as number
               n (cadr pt0)       ;northing coord as number
               east (rtos (/ e 1000) 2 3)  ;easting coord as string
               north (rtos (/ n 1000) 2 3)  ;northing coord as string
               eastin (strcat  east "mE" )
               northin (strcat  north "mN")
         )
  (command "TEXT" pt0 "500" "0" eastin);size of text changed manually
  (command "TEXT" "" northin)
   )
   (princ)
)