[编程交流] 改进常规

;;;  Inicio de programa
(defun columna_planta ()
              ;Definición de la cabecera de bloque:
 (entmake
   '((0 . "Block")
     (2 . "COLUMNA_PLANTA")
     (100 . "AcDbEntity")
     (100 . "AcDbBlockBegin")
     (8 . "S-COL-TEXTO")
     (70 . 2)
     (10 0.0 0.0 0.0)
    )
 )
              ;Definición de circulo:
 (entmake
   '((0 . "Circle")
     (100 . "AcDbCircle")
     (100 . "AcDbEntity")
     (10 0.0 0.0 0.0)
     (40 . 2.9392)
     (62 . 2)
    )
 )
              ;Definición de atributo:
 (entmake
   '((0 . "ATTDEF")
     (8 . "S-COL-TEXTO")
     (10 0.0 0.0 0.0)
     (1 . "")
     (2 . "TIPO-COLUMNA")
     (3 . "TIPO-COLUMNA")
     (62 . 3)
     (7 . "STANDARD")
     (40 . 2)
     (41 . 1.0)
     (50 . 0.0)
     (70 . 0)
     (71 . 0)
     (72 . 4)
     (73 . 0)
    )
 )
              ;Definición de FIN del Bloque:
 (entmake '((0 . "ENDBLK")))
)
(defun c:TC ()
 (setvar 'attreq 1)
 (setvar 'attdia 0)
 (vl-cmdf "_.TEXTSTYLE" "standard")
 (vl-cmdf "layer" "m" "S-COL-TEXTO" "c" "2" "" "")
 (vl-cmdf "_insunits" "0")
 (if (null (tblobjname "BLOCK" "COLUMNA_PLANTA"))
   (columna_planta)
 )
 (prompt
   "\nRutina que inserta bloque tipo de columna "
 )
 (prompt "\nCreado por Alejandro Serrano Araya. © 2014")
 (initget 5)
 (setq escala (getreal "\nIndique escala 1:"))
 (setq scr (* (/ escala 10) 0.001))
 (while
   (setq tipocolumna
     (getstring
       "\nIndique el tipo de columna: (presione ESC para terminar)"
     )
   )
    (setq texto (STRCAT "C" tipocolumna))
    (setq pt (getpoint "\nIndique punto base: "))
    (command "_insert"
        "COLUMNA_PLANTA"
        pt
        (* 1000 scr)
        (* 1000 scr)
        0
        texto
    )
 )
 (princ)
)

;; Circular Wipeout  -  Lee Mac
;; Creates a circular wipeout with the given center (UCS) & radius
(defun LM:CircularWipeout ( cen rad / ang inc lst )
   (setq acc 50
         inc (/ pi acc 0.5)
         ang 0.0
   )
   (repeat acc
       (setq lst (cons (list 14 (* 0.5 (cos ang)) (* 0.5 (sin ang))) lst)
             ang (+ ang inc)
       )
   )
   (entmakex
       (append
           (list
              '(000 . "WIPEOUT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbWipeout")
               (cons 10 (trans (mapcar '- cen (list rad rad)) 1 0))
               (cons 11 (trans (list (+ rad rad) 0.0) 1 0 t))
               (cons 12 (trans (list 0.0 (+ rad rad)) 1 0 t))
              '(280 . 1)
              '(071 . 2)
           )
           (cons (last lst) lst)
       )
   )
)

(defun CW ( p r )
(vl-cmdf "_POLYGON" "32" p "I" r)
(vl-cmdf "_WIPEOUT" "P" "L" "Y")
 )