[编程交流] 帮我把这个Lisp程序写得像t

(VL-LOAD-COM)
(or copy_reactor
   (setq copy_reactor (vlr-command-reactor "copy_reactor" '((:vlr-commandEnded . copy_1))))
)
(setvar "copymode" 1)
(defun C:bz (/ p1 p2 pt1 pt2 pts mSpace Mtextobj)
 (setq mSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
 (setq p1 (getpoint "\nÑ¡ÔñÒª±ê×¢µÄµã:"))
 (setq p2 (getpoint p1 "\nÑ¡Ôñ±ê×¢ÎÄ×ÖλÖÃ:"))
 (setq pt2 (vlax-3D-point p2))
 (setq Mtextobj (vla-addMtext
                  mSpace
                  pt2
                  0.0
                  (strcat "X=" [color="red"](if (minusp (car p1)) "" "+" )[/color](rtos (car p1) 2 1) "\nY=" [color="red"](if (minusp (cadr p1)) "" "+" )[/color](rtos (cadr p1) 2 1))
                )
 )
 (setq MtextH (* (getvar "DIMSCALE") (getvar "DIMTXT"))) ;ÎÄ×ָ߶ÈΪµ±Ç°±êÖùÑùʽÎÄ×ָ߶È*È«¾Ö±ÈÀý
 (vlax-put-property Mtextobj 'Height MtextH)
 (vlax-put-property Mtextobj 'LineSpacingDistance (+ MtextH 1))
 (if (> (car p1) (car p2))
   (vlax-put-property Mtextobj 'AttachmentPoint 9)
   (vlax-put-property Mtextobj 'AttachmentPoint 7)
 )
 (vlax-put-property Mtextobj 'InsertionPoint pt2)
 (setq pts (vlax-make-safearray vlax-vbDouble '(0 . 5)))
 (vlax-safearray-fill
   pts
   (list (car p1) (cadr p1) (caddr p1) (car p2) (cadr p2) (caddr p2))
 )
 (setq leaderobj (vla-Addleader mSpace pts Mtextobj acLineWithArrow))
 (setq vlr-objgx (vlr-object-reactor (list leaderobj) "" '((:vlr-modified . gx))))
 (setq vlr-objcopy (vlr-object-reactor (list leaderobj) "" '((:vlr-copied . copy_2))))
 (princ)
)
(defun copy_2 (obj vlrobj data)
 (if (/= (car data) 0)
   (setq newename (car data))
 )
)
(defun copy_1 (vlrobj data)
 (if (wcmatch (strcase (car data)) "*COPY*")
   (progn (setq newobj (vlax-ename->vla-object newename))
          (setq vlr-objgx (vlr-object-reactor (list newobj) "" '((:vlr-modified . gx))))
          (setq vlr-objcopy (vlr-object-reactor (list newobj) "" '((:vlr-copied . copy_2))))
          (princ)
   )
 )
)
(defun gx (obj vlrobj data / p1 pt1 Aobj)
 (if (and (not (vlax-erased-p obj)) (setq Aobj (vlax-get-property obj 'Annotation))) ;Åж϶ÔÏóÊÇ·ñ±»É¾³ý
   (progn (setq pt1 (vlax-get-property obj 'Coordinate 0))
          (setq p1 (vlax-safearray->list (vlax-variant-value pt1)))
          (vlax-put-property
            Aobj
            'TextString
            (strcat "X=" [color="red"](if (minusp (car p1)) "" "+" )[/color](rtos (car p1) 2 1) "\nY=" [color="red"](if (minusp (car p1))[/color] "" "+" )(rtos (cadr p1) 2 1))
          )
   )
 )
)

(defun C:bz (/ AcadObject AcadDocument mSpace h1 len inp kflag obj1 p1 p2 x y anglel inpx inpy lasp olay tx ty)
 (princ "\n×ø±ê±ê×¢V1.10£¬Ö´ÐÐÃüÁbz")
 (setq olay (getvar "clayer"))
 (setvar "cmdecho" 0)
;;;  ÉèÖÃActiveXµÄ¹¤×÷»·¾³‰äÁ¿
 (VL-LOAD-COM)
 (setq AcadObject   (vlax-get-acad-object)
       AcadDocument (vla-get-ActiveDocument Acadobject)
       mSpace       (vla-get-ModelSpace Acaddocument)
 )
 (setvar "cmdecho" 0)
 (setq kflag t)
 (while kflag
   (chklay)
   (initget "S")
   (if (not h)
     (setq h '1.5)
   )
   (setq
     p (getpoint (strcat "\nÖ¸¶¨Æðµã/¡¾S¡¿ÉèÖÃ×Ö¸ß[<" (rtos h) ">]"))
   )
   (if (= p "S")
     (setq h1 (getreal (strcat "\nÊäÈëÐÂ×Ö¸ß<" (rtos h) ">")))
   )
   (if h1
     (setq h h1)
   )
   (if (and (/= p "S") p)
     (progn
       (drawcross p) ;ÔÚ´æÔÚpµÄÇé¿öÏ»*Ê®×Ö¹â±ê
       (prompt "\nÖ¸¶¨ÏÂÒ»µã£º")
       (command "line" p (getdist p) "")
       (setq obj1 (vlax-ename->vla-object (entlast)))
       (if (= (vlax-get-property obj1 'objectname) "AcDbLine")
         (progn
           (setq p1 (vlax-get obj1 'startpoint))
           (setq p2 (vlax-get obj1 'endpoint))
           (setq x (strcat "X=" (if (minusp (car p1)) "" "+" ) (rtos (car p1) 2 3)))
           (setq y (strcat "Y=" (if (minusp (cadr p1)) "" "+" ) (rtos (cadr p1) 2 3)))
           (setq len (max (strlen x) (strlen y)))
           (setq anglel (vlax-get obj1 'Angle))
           (if (and (> anglel (/ pi 2)) (< anglel (/ (* pi 1.5))))
             ;;ÔÚµÚ¶þ¡¢ÈýÏóÏÞ±ê×¢
             (progn
               (setq lasp (polar p2 (angtof "180") (* (* 0.6 h) len)))
               (setq inp (polar lasp '0 (* 0.2 h)))
               (setq inpx (polar inp (angtof "90") (* 0.2 h)))
               (setq inpy (polar inp (angtof "270") (* 1.1 h)))
               (vla-AddLine mSpace (vlax-3d-point p2) (vlax-3d-point lasp))
               (setq tx (vla-AddText mSpace x (vlax-3d-point inpx) h))
               (setq ty (vla-AddText mSpace y (vlax-3d-point inpy) h))
             ) ;progn
             ;;ÔÚµÚÒ»¡¢ËÄÏóÏÞ±ê×¢
             (progn
               (setq lasp (polar p2 '0 (* (* 0.7 h) len)))
               (setq inp (polar p2 '0 (* 0.3 h)))
               (setq inpx (polar inp (angtof "90") (* 0.2 h)))
               (setq inpy (polar inp (angtof "270") (* 1.1 h)))
               (vla-AddLine mSpace (vlax-3d-point p2) (vlax-3d-point lasp))
               (vla-AddText mSpace x (vlax-3d-point inpx) h)
               (vla-AddText mSpace y (vlax-3d-point inpy) h)
             ) ;progn
           )
         )
       ) ;if
       (if (/= (vlax-get-property obj1 'objectname) "AcDbLine")
         (progn
           (princ "\nÏ߶λæÖÆ´íÎó£¬ÖØлæÖÆ»ò<Í˳ö>")
           (command "_.erase" (entlast) "")
         )
       )
     )
     (if (/= p "S")
       (setq kflag nil) ;ÊäÈëSºó²»ÔÊÐíÌÓÀëÑ*»·
     )
   )
 ) ;while
 (setvar "clayer" olay)
)
(defun chklay (/ layflag)
 (setq layflag (tblsearch "layer" "×ø±ê±ê×¢"))
 (if (not layflag)
   (command "_layer" "m" "×ø±ê±ê×¢" "c" "3" "" "")
 )
 (setvar "clayer" "×ø±ê±ê×¢")
)
(defun drawcross (p / px1 px2 py1 py2)
 (setq eflag (tblsearch "block" "×ø±êÊ®×Ö±ê¼Ç")) ;¿é´æÔÚ±ê¼Ç
 (if (not eflag) ;²»´æÔÚÊ®×Ö±ê¼ÇµÄ¿é£¬Ôò°´ÈçÏ´´½¨
   (progn
     (setq px1 (polar p (angtof "180") 1.5) ;×ó×ø±ê
           px2 (polar p '0 '1.5) ;ÓÒ×ø±ê
           py1 (polar p (angtof "90") '1.5) ;ÉÏ×ø±ê
           py2 (polar p (angtof "270") '1.5) ;ÏÂ×ø±ê
     )
     (entmake (list
                (cons 0 "BLOCK")
                (cons 2 "×ø±êÊ®×Ö±ê¼Ç")
                (cons 70 0)
                (cons 10 p)
              )
     )
     (entmake (list
                (cons 0 "LINE")
                (cons 10 px1)
                (cons 11 px2)
              )
     )
     (entmake (list
                (cons 0 "LINE")
                (cons 10 py1)
                (cons 11 py2)
              )
     )
     (entmake '((0 . "endblk")))
   ) ;progn
 ) ;if
 (command "_insert" "×ø±êÊ®×Ö±ê¼Ç" p (/ h 3.5) (/ h 3.5) "0")
)

(defun c:lb (/ p x y str)
 (while (setq p (getpoint "\nPick Point: "))
    (setq   x (strcat "X = " (if (minusp (car p)) ""  "+" ) (rtos (car   p))))
    (setq   y (strcat "Y = " (if (minusp (cadr p)) "" "+" ) (rtos (cadr  p))))
    (setq str (strcat x "\n" y))
   ;(setq   z (strcat "Z = "(if (minusp (caddr p)) "" "+" ) (rtos (caddr p))))
   ;(setq str (strcat x "\n" y "\n" z))                                       
    (command "_LEADER" p pause "" str "")
 )
)

(defun C:bz (/ AcadObject AcadDocument mSpace h1 len inp kflag obj1 p1 p2 x y anglel inpx inpy lasp olay tx ty)
 (princ "\n×ø±ê±ê×¢V1.10£¬Ö´ÐÐÃüÁbz")
 (setq olay (getvar "clayer"))
 (setvar "cmdecho" 0)
;;;  ÉèÖÃActiveXµÄ¹¤×÷»·¾³‰äÁ¿
 (VL-LOAD-COM)
 (setq AcadObject   (vlax-get-acad-object)
       AcadDocument (vla-get-ActiveDocument Acadobject)
       mSpace       (vla-get-ModelSpace Acaddocument)
 )
 (setvar "cmdecho" 0)
 (setq kflag t)
 (while kflag
   (chklay)
   (initget "S")
   (if (not h)
     (setq h '1.5)
   )
   (setq
     p (getpoint (strcat "\nÖ¸¶¨Æðµã/¡¾S¡¿ÉèÖÃ×Ö¸ß[<" (rtos h) ">]"))
   )
   (if (= p "S")
     (setq h1 (getreal (strcat "\nÊäÈëÐÂ×Ö¸ß<" (rtos h) ">")))
   )
   (if h1
     (setq h h1)
   )
   (if (and (/= p "S") p)
     (progn
       (drawcross p) ;ÔÚ´æÔÚpµÄÇé¿öÏ»*Ê®×Ö¹â±ê
       (prompt "\nÖ¸¶¨ÏÂÒ»µã£º")
       (command "line" p (getdist p) "")
       (setq obj1 (vlax-ename->vla-object (entlast)))
       (if (= (vlax-get-property obj1 'objectname) "AcDbLine")
         (progn
           (setq p1 (vlax-get obj1 'startpoint))
           (setq p2 (vlax-get obj1 'endpoint))
           (setq x (strcat "X=" (if (minusp (car p1)) "" "+" ) (rtos (car p1) 2 3)))
           (setq y (strcat "Y=" (if (minusp (cadr p1)) "" "+" ) (rtos (cadr p1) 2 3)))
           (setq len (max (strlen x) (strlen y)))
           (setq anglel (vlax-get obj1 'Angle))
           (if (and (> anglel (/ pi 2)) (< anglel (/ (* pi 1.5))))
             ;;ÔÚµÚ¶þ¡¢ÈýÏóÏÞ±ê×¢
             (progn
               (setq lasp (polar p2 (angtof "180") (* (* 0.6 h) len)))
               (setq inp (polar lasp '0 (* 0.2 h)))
               (setq inpx (polar inp (angtof "90") (* 0.2 h)))
               (setq inpy (polar inp (angtof "270") (* 1.1 h)))
               (vla-AddLine mSpace (vlax-3d-point p2) (vlax-3d-point lasp))
               (setq tx (vla-AddText mSpace x (vlax-3d-point inpx) h))
               (setq ty (vla-AddText mSpace y (vlax-3d-point inpy) h))
             ) ;progn
             ;;ÔÚµÚÒ»¡¢ËÄÏóÏÞ±ê×¢
             (progn
               (setq lasp (polar p2 '0 (* (* 0.7 h) len)))
               (setq inp (polar p2 '0 (* 0.3 h)))
               (setq inpx (polar inp (angtof "90") (* 0.2 h)))
               (setq inpy (polar inp (angtof "270") (* 1.1 h)))
               (vla-AddLine mSpace (vlax-3d-point p2) (vlax-3d-point lasp))
               (vla-AddText mSpace x (vlax-3d-point inpx) h)
               (vla-AddText mSpace y (vlax-3d-point inpy) h)
             ) ;progn
           )
         )
       ) ;if
       (if (/= (vlax-get-property obj1 'objectname) "AcDbLine")
         (progn
           (princ "\nÏ߶λæÖÆ´íÎó£¬ÖØлæÖÆ»ò<Í˳ö>")
           (command "_.erase" (entlast) "")
         )
       )
     )
     (if (/= p "S")
       (setq kflag nil) ;ÊäÈëSºó²»ÔÊÐíÌÓÀëÑ*»·
     )
   )
 ) ;while
 (setvar "clayer" olay)
)
(defun chklay (/ layflag)
 (setq layflag (tblsearch "layer" "×ø±ê±ê×¢"))
 (if (not layflag)
   (command "_layer" "m" "×ø±ê±ê×¢" "c" "3" "" "")
 )
 (setvar "clayer" "×ø±ê±ê×¢")
)
(defun drawcross (p / px1 px2 py1 py2)
 (setq eflag (tblsearch "block" "×ø±êÊ®×Ö±ê¼Ç")) ;¿é´æÔÚ±ê¼Ç
 (if (not eflag) ;²»´æÔÚÊ®×Ö±ê¼ÇµÄ¿é£¬Ôò°´ÈçÏ´´½¨
   (progn
     (setq px1 (polar p (angtof "180") 1.5) ;×ó×ø±ê
           px2 (polar p '0 '1.5) ;ÓÒ×ø±ê
           py1 (polar p (angtof "90") '1.5) ;ÉÏ×ø±ê
           py2 (polar p (angtof "270") '1.5) ;ÏÂ×ø±ê
     )
     (entmake (list
                (cons 0 "BLOCK")
                (cons 2 "×ø±êÊ®×Ö±ê¼Ç")
                (cons 70 0)
                (cons 10 p)
              )
     )
     (entmake (list
                (cons 0 "LINE")
                (cons 10 px1)
                (cons 11 px2)
              )
     )
     (entmake (list
                (cons 0 "LINE")
                (cons 10 py1)
                (cons 11 py2)
              )
     )
     (entmake '((0 . "endblk")))
   ) ;progn
 ) ;if
 (command "_insert" "×ø±êÊ®×Ö±ê¼Ç" p (/ h 3.5) (/ h 3.5) "0")
)

(defun c:lb (/ p x y str)
 (while (setq p (getpoint "\nPick Point: "))
    (setq   x (strcat "X = " (if (minusp (car p)) ""  "+" ) (rtos (car   p))))
    (setq   y (strcat "Y = " (if (minusp (cadr p)) "" "+" ) (rtos (cadr  p))))
    (setq str (strcat x "\n" y))
   ;(setq   z (strcat "Z = "(if (minusp (caddr p)) "" "+" ) (rtos (caddr p))))
   ;(setq str (strcat x "\n" y "\n" z))                                       
    (command "_LEADER" p pause "" str "")
 )
)

(defun c:lb ( / p x y str )
 (if (not (tblsearch "LAYER" "dim"))
   (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "dim") (70 . 0) (62 . 3) (6 . "Continuous")))
   (prompt "\nLayer : "dim" already exist - setting it to current and proceeding with routine...")
 )
 (setvar 'clayer "dim")
 (while (setq p (getpoint "\nPick Point - ENTER to finish: "))
    (setq   x (strcat "X = " (if (minusp (car p)) ""  "+" ) (rtos (car p) 2 2)))
    (setq   y (strcat "Y = " (if (minusp (cadr p)) "" "+" ) (rtos (cadr p) 2 2)))
    (setq str (strcat x "\n" y))
   ;(setq   z (strcat "Z = "(if (minusp (caddr p)) "" "+" ) (rtos (caddr p) 2 2)))
   ;(setq str (strcat x "\n" y "\n" z))                                       
    (command "_LEADER" p pause "" str "")
 )
 (princ)
)