[编程交流] 自动编号？

;; ============ Num.lsp ===============
;;
;;  FUNCTION:
;;  Will sequentially place numerical
;;  text upon mouse click, with optional
;;  prefix and suffix.
;;
;;  SYNTAX: num
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  PLATFORMS:
;;  No Restrictions,
;;  only tested in ACAD 2004.
;;
;;  VERSION:
;;  1.0  ~  05.04.2009
;;
;; ====================================
(defun c:num  (/ vlst ovar dVars tmpVars pt)
 (setq    vlst '("OSMODE" "CLAYER")
   ovar (mapcar 'getvar vlst))
 (setvar "OSMODE" 0)
 (or (tblsearch "LAYER" "NumText")
     (vla-put-color
   (vla-add
     (vla-get-layers
       (vla-get-ActiveDocument
         (vlax-get-acad-object))) "NumText") acYellow))
 (setq dVars '(sNum inNum Pref Suff))
 (mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 1 "" ""))
 (setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
             (getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
             (getstring (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: "))
             (getstring (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: "))))
 (mapcar '(lambda (x y) (or (or (not x) (eq "" x)) (set y x))) tmpVars dVars)
 (while (setq pt (getpoint "\nClick for Text... "))
   (Make_Text pt (strcat Pref (rtos sNum 2 2) Suff))
   (setq sNum (+ sNum inNum)))
 (mapcar 'setvar vlst ovar)
 (princ))
(defun Make_Text  (txt_pt txt_val)
 (entmake (list '(0 . "TEXT")
        '(8 . "NumText")
        (cons 10 txt_pt)
        (cons 40 (max 2.5 (getvar "TEXTSIZE")))
        (cons 1 txt_val)
        '(50 . 0.0)
        (cons 7 (getvar "TEXTSTYLE"))
        '(71 . 0)
        '(72 . 1)
        '(73 . 2)
        (cons 11 txt_pt))))

;; ============ Num.lsp ===============
;;
;;  FUNCTION:
;;  Will sequentially place numerical
;;  text upon mouse click, with optional
;;  prefix and suffix.
;;
;;  SYNTAX: num
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  PLATFORMS:
;;  No Restrictions,
;;  only tested in ACAD 2010.
;;
;;  VERSION:
;;  1.0  ~  05.04.2009
;;  2.0  ~  15.06.2009
;;
;; ====================================
(defun c:num  (/ dVars tmpVars pt ang sNum*)
 (setq dVars '(sNum eNum inNum Spc Dir))
 (mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 10 1 1 "X"))
 (setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
                     (getreal (strcat "\nSpecify Ending Number <" (rtos eNum 2 2) ">: "))
                     (getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
                     (getreal (strcat "\nSpecify Spacing <" (rtos Spc 2 2) ">: "))))
 (initget "X Y")
 (setq tmpVars
   (append tmpVars (list (getkword (strcat "\nSpecify Direction [X/Y] <" Dir ">: ")))))
 (mapcar '(lambda (x y) (or (not x) (set y x))) tmpVars dVars)
 (if (eq Dir "X") (setq ang 0) (setq ang (/ pi 2)))
 (if (setq pt (getpoint "\nSpecify Start Point: ") i 0 sNum* sNum)
   (while (<= sNum* eNum)
     (Make_Text (polar pt ang (* i Spc)) (rtos sNum* 2 2))
     (setq sNum* (+ sNum* inNum) i (1+ i))))
 (princ))
(defun Make_Text  (pt val)
 (entmake
   (list
     (cons 0 "TEXT")
     (cons 8 (getvar "CLAYER"))
     (cons 10 pt)
     (cons 62 2)
     (cons 40 (getvar "TEXTSIZE"))
     (cons 1 val)
     (cons 50 0.0)
     (cons 7 (getvar "TEXTSTYLE"))
     (cons 71 0)
     (cons 72 1)
     (cons 73 2)
     (cons 11 pt))))

  (Make_Text (polar pt ang (* i Spc)) (rtos sNum* 2 2))

;                       ***  JUSTIFY.LSP  ***
;
; Changes the justification of text to:-
;       Left, Center, Right, Aligned, Middle, Fit,
;       Bottom left, center or right,
;       Middle left, center or right, OR
;       Top left, center of right
;
(defun C:JUSTIFY (/ a a1 a2 a3 a4 t m n n1 p1
                   p q j j0 n2 j1 j2 q1 index dummy)
 (setvar "cmdecho" 0)
 (graphscr)
 (prompt "\n *  Select text to change justification...")(terpri)
 (setq t (ssget))
 (if $just
   (setq dummy nil)
   (setq $just "C")
 )
 (prompt "\n *  Enter appropriate letter or select from pull down menu...")
 (initget "L C R A M F BL BC BR ML MC MR TL TC TR")
 (setq j1 (getkword (strcat
   "\n *  L/C/R/M/A/F/BL/BC/BR/ML/MC/MR/TL/TC/TR: <" $just "> ")))
 (if (= j1 "")
   (setq j1 $just)
   (setq $just j1)
 )
 (setq m (sslength t)
       index 0)
 (repeat m
   (setq a (entget (ssname t index))
         p (cdr (assoc 0 a)))
   (if (= p "TEXT")
     (progn
        (setq j (assoc 72 a)
              j2 (assoc 73 a)
              p (assoc 10 a)
              q (assoc 11 a)
              j0 (cdr j))
        (if (or (= j1 "L")(= j1 "C")(= j1 "R")(= j1 "M")
                (= j1 "BL")(= j1 "BC")(= j1 "BR")
                (= j1 "ML")(= j1 "MC")(= j1 "MR")
                (= j1 "TL")(= j1 "TC")(= j1 "TR"))
          (if (= j0 0)
            (progn
              (setq p1 (cdr p)
                    q1 (cons (car q) p1)
                    n1 (subst q1 q a))
            )
            (progn
              (setq q1 (cdr q)
                    p1 (cons (car p) q1)
                    n1 (subst p1 p a))
            )
          )
        )
        (if (or (= j1 "A")(= j1 "F"))
          (progn
            (prompt "\n ")
            (prin1 (+ index 1))
            (setq a1 (getpoint "\nEnter first alignment point...")
                  a2 (getpoint "\nEnter second alignment point...")
                  a3 (cons (car p) a1)
                  a4 (cons (car q) a2)
                  n1 (subst a3 p a)
                  n2 (subst a4 q n1))
          )
        )
        (cond ((= j1 "L")  (setq n (subst '(72 . 0) j n1))
                           (setq n (subst '(73 . 0) j2 n)))
              ((= j1 "C")  (setq n (subst '(72 . 1) j n1))
                           (setq n (subst '(73 . 0) j2 n)))
              ((= j1 "R")  (setq n (subst '(72 . 2) j n1))
                           (setq n (subst '(73 . 0) j2 n)))
              ((= j1 "A")  (setq n (subst '(72 . 3) j n2))
                           (setq n (subst '(73 . 0) j2 n)))
              ((= j1 "M")  (setq n (subst '(72 . 4) j n1))
                           (setq n (subst '(73 . 0) j2 n)))
              ((= j1 "F")  (setq n (subst '(72 . 5) j n2))
                           (setq n (subst '(73 . 0) j2 n)))
              ((= j1 "BL") (setq n (subst '(72 . 0) j n1))
                           (setq n (subst '(73 . 1) j2 n)))
              ((= j1 "BC") (setq n (subst '(72 . 1) j n1))
                           (setq n (subst '(73 . 1) j2 n)))
              ((= j1 "BR") (setq n (subst '(72 . 2) j n1))
                           (setq n (subst '(73 . 1) j2 n)))
              ((= j1 "ML") (setq n (subst '(72 . 0) j n1))
                           (setq n (subst '(73 . 2) j2 n)))
              ((= j1 "MC") (setq n (subst '(72 . 1) j n1))
                           (setq n (subst '(73 . 2) j2 n)))
              ((= j1 "MR") (setq n (subst '(72 . 2) j n1))
                           (setq n (subst '(73 . 2) j2 n)))
              ((= j1 "TL") (setq n (subst '(72 . 0) j n1))
                           (setq n (subst '(73 . 3) j2 n)))
              ((= j1 "TC") (setq n (subst '(72 . 1) j n1))
                           (setq n (subst '(73 . 3) j2 n)))
              ((= j1 "TR") (setq n (subst '(72 . 2) j n1))
                           (setq n (subst '(73 . 3) j2 n)))
        )
        (entmod n)
     )
   )
   (setq index (+ index 1))
 )
 (prin1)
 (princ "    Changed ")                ; Print total lines changed
 (princ index)
 (princ " text lines.")
 (terpri)
 (princ)
)

(cond ((= j1 "L")  (setq n (subst '(72 . 0) j n1))
                           (setq n (subst '(73 . 0) j2 n)))

(cons 7 (getvar "TEXTSTYLE"))
        '(71 . 0)
        '(72 . 1)
        '(73 . 2)