[编程交流] 我需要一个LISP或工具Pac

(defun c:TesT (/ *error* hgt cmd i icar icadr icaddr pt1 pt2 e)
 ; Tharwat 01. 05. 201
 (defun *error* (msg)
 (and cmd (setvar 'cmdecho cmd))
 (redraw)
 (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
   (princ (strcat "\nError: " msg))
 )
)
 (setq Sty (tblnext "STYLE" (null Sty)))
 (setq cmd (getvar 'cmdecho))
 (setvar 'cmdecho 0)
       (while
           (setq i (getpoint "\n Specify Corrdinates Point :")
            icar (car i)
            icadr (cadr i)
                icaddr (caddr i))
            (setq pt1 (getpoint "\n Second point of QLeader :" i ))
            (grdraw i pt1 3 1)
            (setq pt2 (getpoint "\n Last point of QLeader :" pt1 ))
 (entmakex (list (cons 0 "LEADER") (cons 100 "AcDbEntity") (cons 100 "AcDbLeader")
         (cons 10 i)(cons 10 PT1)(cons 10 PT2)(cons 71 1)(cons 72 0)(cons 73 3)))
 (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 (trans pt2 1 0))
           (cons 40 (cdr (assoc (if (zerop (cdr (assoc 40 Sty))) 42 40) Sty )))
           (cons 1 (strcat "N" ":" (rtos icar 2 0) "\n" "E" ":" (rtos icadr 2 0)))))
 
     (redraw)
      )
 (setvar 'cmdecho cmd)
 (princ)
 )
 

(defun c:TesT (/ *error* hgt cmd i icar icadr pt1 pt2 e)
                                       ; Tharwat 01. 05. 201
 (defun *error* (msg)
   (and cmd (setvar 'cmdecho cmd))
   (redraw)
   (if (and msg
            (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
       )
     (princ (strcat "\nError: " msg))
   )
 )
 (setq Sty (tblnext "STYLE" (null Sty)))
 (setq cmd (getvar 'cmdecho))
 (setvar 'cmdecho 0)
 (while
   (setq i     (getpoint "\n Specify Corrdinates Point :")
         icar  (car i)
         icadr (cadr i)
   )
    (setq pt1 (getpoint "\n Second point of QLeader :" i))
    (grdraw i pt1 3 1)
    (setq pt2 (getpoint "\n Last point of QLeader :" pt1))
    (entmakex (list (cons 0 "LEADER")
                    (cons 100 "AcDbEntity")
                    (cons 100 "AcDbLeader")
                    (cons 10 i)
                    (cons 10 PT1)
                    (cons 10 PT2)
                    (cons 71 1)
                    (cons 72 0)
                    (cons 73 3)
              )
    )
    (entmakex
      (list (cons 0 "MTEXT")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 10 (trans pt2 1 0))
            (cons 40
                  (cdr (assoc (if (zerop (cdr (assoc 40 Sty)))
                                42
                                40
                              )
                              Sty
                       )
                  )
            )
            (cons 1
                  (strcat "E"
                          ":"
                          (rtos icar 2 0)
                          "\n"
                          "N"
                          ":"
                          (rtos icadr 2 0)
                  )
            )
      )
    )
    (redraw)
 )
 (setvar 'cmdecho cmd)
 (princ)
)