[编程交流] 从lisp插入文本

(defun c:spot ( / pt1 file1)
(if (not (tblsearch "Layer" "TEXT"))
(command "-layer" "m" "TEXT" "")
) 
(setq file1 (open "E:\\Morgos\\AutoCadd\\sh.csv" "r"))
(setq pt1 (read-line file1))
(while 
(/= pt1 nil)
(setq pt (read-line file1))
(setq sx (substr pt 1 9))
(setq sy (substr pt 13 22))
(setq sz (substr pt 26 31))
(setq fx (atof sx))
(setq fy (atof sy))
(setq fz (atof sz))
(setq Lpt (list fx fy fz))
(entmake (list '(0 . "MTEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbMText")
'(8 . "TEXT")
(cons 10 Lpt)
'(40 . 2.5) 
(cons 1 sz)
'(50 . 0.0)
'(7 . "STANDARD") 
'(71 . 0)
'(72 . 0)
'(73 . 0)
) ;_ end list
) ;_ end entmake
) ;_ end while
(princ) 
) ;_ end defun

(defun make_text  (txt_pt txt_val)
 (entmake (list '(0 . "TEXT")
                '(8 . "0")
                (cons 10 txt_pt)
                (cons 40 (max 2.5 (getvar "TEXTSIZE")))
                (cons 1 txt_val)
                '(50 . 0.0)
                '(7 . "STANDARD")
                '(71 . 0)
                '(72 . 1)
                '(73 . 2)
                (cons 11 txt_pt))))

(if 
       (setq *ht*
         (cond
           ((getdist (strcat "\nSpecify the height of the text <" (if *ht* (rtos *ht* 2 3) "") ">:[0.5/1.0/1.5/2.0/2.5/3.0]")))
           (*ht*)
         )
       )
       (progn
         (setq e
           (entmakex
             (list
               '(0 . "MTEXT")
               '(100 . "AcDbEntity")
               '(100 . "AcDbMText")
               (cons 8 "Area")
               (cons 62 256)
               (cons 10 '(0 0 0))
               (cons 7 (getvar 'textstyle))
               (cons 40 *ht*)
               (cons 41 0)
               (cons 1
                     (strcat
                       "Land area is : " oar decl
                 )
               )
             )
           )
         )
         (setq e (vlax-ename->vla-object e))
         (grread t)
          (while (not enter)
           (princ "\nSpecify the insertion point of the text...")
           (setq grp (grread T 5 0)
                 reason (car grp)
                 value (cadr grp)
           )
           (cond
             ((or (member reason '(11 12 25)) (= value 13) (= value 32)) (vla-delete e) (setq enter t)) 
             ((= reason 5) (vlax-put e 'InsertionPoint (trans value 1 0)))
             ((= reason 3) (setq enter t))
           )
         )
       )
       (princ
         (strcat
           "\n\tLand area is : " oar decl
                
         )
       )
    )

(defun c:test (  / [color="red"] enter[/color] )
...
...
([color="blue"]while[/color] ( not[color="red"] enter [/color])
...
...

9