Alejandros85 发表于 2022-7-5 22:54:34

改进常规

各位下午好，
我被要求创建一个rutine，它插入一个具有属性的块，以插入列类型的标签，这是一个圆形，其中列的文本位于圆形内，例如：C1、C2、C3等。
我已经这样做了，问题是我需要在标签的圆周围插入一个擦拭块，但我不知道怎么做。我想知道这里是否有人能帮我绕着圆圈抹平，我会非常感激的！
这是代码。祝福。
 
;;;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)
)

hanhphuc 发表于 2022-7-5 23:23:58

你好
由于WIPEOUT适用于多段线，因此使用命令的最简单方法是：具有32条边的多边形看起来像一个圆

marko_ribar 发表于 2022-7-5 23:54:18

我当然会使用HATCH，但这里有一个方法-看http://www.lee-mac.com并在“程序”下搜索循环擦除。。。以下是您需要实现的部分代码：
 

;; 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)
       )
   )
)

hanhphuc 发表于 2022-7-6 00:14:00

感谢Marko分享Lee的代码。真正纯粹的编码解释了命令背后的“多边形”和“擦除”：）
 
简而言之：


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

页: [1]
查看完整版本: 改进常规