[LISP程序]：把text转为属性图块

LUCAS

2. 
   
3. ;;把text转为属性图块
   
4. ;;By LUCAS
   
5. (defun C:C_DEF (/ HOLDECHO HOLDBLIP HOLDREQ SS SSS N A AA A1 A73 HH
   
6.                 LST_210        LST_10
   
7.                )
   
8. 
   
9.   (defun DXF (A1 A2 /)
   
10.     (setq ENT (cdr (assoc A1 A2)))
    
11.   )
    
12. 
    
13.   (defun GETATT        (E ATTNAME / N ATT E1 EN EN1 RSLT)
    
14.     (setq EN (entget E)
    
15.           E1 E
    
16.     )
    
17.     (if        (and (= (DXF 0 EN) "INSERT")
    
18.              (= (DXF 66 EN) 1)
    
19.         )
    
20.       (progn
    
21.         (setq E1  (entnext E1)
    
22.               ATT (strcase ATTNAME)
    
23.         )
    
24.         (while (and E1
    
25.                     (setq EN1 (entget E1))
    
26.                     (= (DXF 0 EN1) "ATTRIB")
    
27.                )
    
28.           (setq RSLT (append RSLT (list (DXF -1 EN1))))
    
29.           (setq E1 (entnext E1))
    
30.         )
    
31.       )
    
32.     )
    
33.     (setq N 0)
    
34.     (repeat (length RSLT)
    
35.       (entmod (subst (nth N LST_210)
    
36.                      (assoc 210 (entget (nth N RSLT)))
    
37.                      (entget (nth N RSLT))
    
38.               )
    
39.       )
    
40.       (entmod (subst (nth N LST_10)
    
41.                      (assoc 10 (entget (nth N RSLT)))
    
42.                      (entget (nth N RSLT))
    
43.               )
    
44.       )
    
45.       (setq N (1+ N))
    
46.     )
    
47.     (entupd (entlast))
    
48.   )
    
49. 
    
50.   (command "_.undo" "_group")
    
51.   (setq HOLDECHO (getvar "cmdecho"))
    
52.   (setq HOLDBLIP (getvar "blipmode"))
    
53.   (setq HOLDREQ (getvar "attreq"))
    
54.   (setvar "cmdecho" 0)
    
55.   (setvar "blipmode" 0)
    
56.   (while (or (= SSS NIL) (= SS NIL))
    
57.     (setq SSS (ssget))
    
58.     (setq SS (ssget "P" '((0 . "TEXT"))))
    
59.   )
    
60.   (command "_.UCS" "")
    
61.   (setq N 0)
    
62.   (setq HH (ssadd))
    
63.   (repeat (sslength SS)
    
64.     (setq A (ssname SS N))
    
65.     (setq LST_210 (append LST_210 (list (assoc 210 (entget A)))))
    
66.     (setq LST_10 (append LST_10 (list (assoc 10 (entget A)))))
    
67.     (setq AA (member '(100 . "AcDbEntity") (entget A)))
    
68.     (setq A73 (cdr (assoc 73 AA)))
    
69.     (setq A1 (cdr (assoc 1 AA)))
    
70.     (entmake (append '((0 . "ATTDEF"))
    
71.                      (reverse (cddr (reverse AA)))
    
72.                      '((100 . "AcDbAttributeDefinition")
    
73.                        (70 . 8)
    
74.                        ;;(73 . 0)
    
75.                       )
    
76.                      (list (cons 74 A73)
    
77.                            (cons 3 A1)
    
78.                            (cons 2 A1)
    
79.                      )
    
80.              )
    
81.     )
    
82.     (ssadd (entlast) HH)
    
83.     (setq N (1+ N))
    
84.   )
    
85.   (command "_.erase" SS "")
    
86.   (setq A (rtos (* (getvar "CDATE") 1E8)))
    
87.   (command "_.BLOCK" A "0,0" HH SSS "")
    
88.   (setvar "attreq" 0)
    
89.   (command "_.INSERT" A "0,0" "" "" "")
    
90.   (setvar "attreq" HOLDREQ)
    
91.   (GETATT (entlast) A)                        ;处理text对象不在X-Y平面
    
92.   (command "_.UCS" "P")
    
93.   (setvar "blipmode" HOLDBLIP)
    
94.   (setvar "cmdecho" HOLDECHO)
    
95.   (command "_.undo" "_end")
    
96.   (princ)
    
97. )
    
98. (prompt "\nType C_DEF")
    
99. (princ)
    

<br /> ;;把text转为属性图块<br /> ;;By LUCAS<br /> (defun C:C_DEF (/ HOLDECHO HOLDBLIP HOLDREQ SS SSS N A AA A1 A73 HH<br />                 LST_210        LST_10<br />                )<br /> <br />   (defun DXF (A1 A2 /)<br />     (setq ENT (cdr (assoc A1 A2)))<br />   )<br /> <br />   (defun GETATT        (E ATTNAME / N ATT E1 EN EN1 RSLT)<br />     (setq EN (entget E)<br />           E1 E<br />     )<br />     (if        (and (= (DXF 0 EN) "INSERT")<br />              (= (DXF 66 EN) 1)<br />         )<br />       (progn<br />         (setq E1  (entnext E1)<br />               ATT (strcase ATTNAME)<br />         )<br />         (while (and E1<br />                     (setq EN1 (entget E1))<br />                     (= (DXF 0 EN1) "ATTRIB")<br />                )<br />           (setq RSLT (append RSLT (list (DXF -1 EN1))))<br />           (setq E1 (entnext E1))<br />         )<br />       )<br />     )<br />     (setq N 0)<br />     (repeat (length RSLT)<br />       (entmod (subst (nth N LST_210)<br />                      (assoc 210 (entget (nth N RSLT)))<br />                      (entget (nth N RSLT))<br />               )<br />       )<br />       (entmod (subst (nth N LST_10)<br />                      (assoc 10 (entget (nth N RSLT)))<br />                      (entget (nth N RSLT))<br />               )<br />       )<br />       (setq N (1+ N))<br />     )<br />     (entupd (entlast))<br />   )<br /> <br />   (command "_.undo" "_group")<br />   (setq HOLDECHO (getvar "cmdecho"))<br />   (setq HOLDBLIP (getvar "blipmode"))<br />   (setq HOLDREQ (getvar "attreq"))<br />   (setvar "cmdecho" 0)<br />   (setvar "blipmode" 0)<br />   (while (or (= SSS NIL) (= SS NIL))<br />     (setq SSS (ssget))<br />     (setq SS (ssget "P" '((0 . "TEXT"))))<br />   )<br />   (command "_.UCS" "")<br />   (setq N 0)<br />   (setq HH (ssadd))<br />   (repeat (sslength SS)<br />     (setq A (ssname SS N))<br />     (setq LST_210 (append LST_210 (list (assoc 210 (entget A)))))<br />     (setq LST_10 (append LST_10 (list (assoc 10 (entget A)))))<br />     (setq AA (member '(100 . "AcDbEntity") (entget A)))<br />     (setq A73 (cdr (assoc 73 AA)))<br />     (setq A1 (cdr (assoc 1 AA)))<br />     (entmake (append '((0 . "ATTDEF"))<br />                      (reverse (cddr (reverse AA)))<br />                      '((100 . "AcDbAttributeDefinition")<br />                        (70 . 8)<br />                        ;;(73 . 0)<br />                       )<br />                      (list (cons 74 A73)<br />                            (cons 3 A1)<br />                            (cons 2 A1)<br />                      )<br />              )<br />     )<br />     (ssadd (entlast) HH)<br />     (setq N (1+ N))<br />   )<br />   (command "_.erase" SS "")<br />   (setq A (rtos (* (getvar "CDATE") 1E8)))<br />   (command "_.BLOCK" A "0,0" HH SSS "")<br />   (setvar "attreq" 0)<br />   (command "_.INSERT" A "0,0" "" "" "")<br />   (setvar "attreq" HOLDREQ)<br />   (GETATT (entlast) A)                        ;处理text对象不在X-Y平面<br />   (command "_.UCS" "P")<br />   (setvar "blipmode" HOLDBLIP)<br />   (setvar "cmdecho" HOLDECHO)<br />   (command "_.undo" "_end")<br />   (princ)<br /> )<br /> (prompt "\nType C_DEF")<br /> (princ)<br />

fango

...       
        (while (and E1
                    (setq EN1 (entget E1))
                    (= (DXF 0 EN1) "ATTRIB")
               )
          (setq RSLT (append RSLT (list (DXF -1 EN1))))
          (setq E1 (entnext E1))
        )
      )
....
请问这里面的dxf是哪里的函数，AUTOCAD自带的吗？下面的reverse(...)呢？

好为人师

变成无名块？没什么用啊

125740513

最初由 好为人师 发布
[B]变成无名块？没什么用啊 [/B]

如果你做统计就很有用。

sandylin2009

请问,无名块是怎么弄出来的啊

bridgewind

最初由 125740513 发布
[B]


如果你做统计就很有用。 [/B]

请详述，请教。。

killer9806

无名块有什么意义哦，请详述

125740513

不是无名的，斑竹的程序可以说是快速定义可编辑属性的块。块的名称是计算机的时间，只是比较长。修改为下面的就可以输入块的名称了，如果直接回车还是以原来的方式命名。

;;把text转为属性图块
;;By LUCAS
;;add block name dim
(defun C:C_DEF (/ HOLDECHO HOLDBLIP HOLDREQ SS SSS N A AA A1 A73 HH
                LST_210        LST_10
               )

  (defun DXF (A1 A2 /)
    (setq ENT (cdr (assoc A1 A2)))
  )

  (defun GETATT        (E ATTNAME / N ATT E1 EN EN1 RSLT)
    (setq EN (entget E)
          E1 E
    )
    (if        (and (= (DXF 0 EN) "INSERT")
             (= (DXF 66 EN) 1)
        )
      (progn
        (setq E1  (entnext E1)
              ATT (strcase ATTNAME)
        )
        (while (and E1
                    (setq EN1 (entget E1))
                    (= (DXF 0 EN1) "ATTRIB")
               )
          (setq RSLT (append RSLT (list (DXF -1 EN1))))
          (setq E1 (entnext E1))
        )
      )
    )
    (setq N 0)
    (repeat (length RSLT)
      (entmod (subst (nth N LST_210)
                     (assoc 210 (entget (nth N RSLT)))
                     (entget (nth N RSLT))
              )
      )
      (entmod (subst (nth N LST_10)
                     (assoc 10 (entget (nth N RSLT)))
                     (entget (nth N RSLT))
              )
      )
      (setq N (1+ N))
    )
    (entupd (entlast))
  )

  (command "_.undo" "_group")
  (setq HOLDECHO (getvar "cmdecho"))
  (setq HOLDBLIP (getvar "blipmode"))
  (setq HOLDREQ (getvar "attreq"))
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (while (or (= SSS NIL) (= SS NIL))
    (setq SSS (ssget))
    (setq SS (ssget "P" '((0 . "TEXT"))))
  )
  (command "_.UCS" "")
  (setq N 0)
  (setq HH (ssadd))
  (repeat (sslength SS)
    (setq A (ssname SS N))
    (setq LST_210 (append LST_210 (list (assoc 210 (entget A)))))
    (setq LST_10 (append LST_10 (list (assoc 10 (entget A)))))
    (setq AA (member '(100 . "AcDbEntity") (entget A)))
    (setq A73 (cdr (assoc 73 AA)))
    (setq A1 (cdr (assoc 1 AA)))
    (entmake (append '((0 . "ATTDEF"))
                     (reverse (cddr (reverse AA)))
                     '((100 . "AcDbAttributeDefinition")
                       (70 . 8)
                       ;;(73 . 0)
                      )
                     (list (cons 74 A73)
                           (cons 3 A1)
                           (cons 2 A1)
                     )
             )
    )
    (ssadd (entlast) HH)
    (setq N (1+ N))
  )
  (command "_.erase" SS "")
  (setq A (getstring "Input new block name: "))  ;; add
  (if (= A "")
  (setq A (rtos (* (getvar "CDATE") 1E8)))
   )                                                                      ;; add
  (command "_.BLOCK" A "0,0" HH SSS "")
  (setvar "attreq" 0)
  (command "_.INSERT" A "0,0" "" "" "")
  (setvar "attreq" HOLDREQ)
  (GETATT (entlast) A)                        ;处理text对象不在X-Y平面
  (command "_.UCS" "P")
  (setvar "blipmode" HOLDBLIP)
  (setvar "cmdecho" HOLDECHO)
  (command "_.undo" "_end")
  (princ)
)
(prompt "\nType C_DEF")
(princ)

zqb05

不错
好样的

tboy2080

这个东西还蛮使用，谢谢楼主

狼墨

125740513 发表于 2006-11-1 21:57
不是无名的，斑竹的程序可以说是快速定义可编辑属性的块。块的名称是计算机的时间，只是比较长。修改为下面 ...

图块的基点飞得很远，如果图块的基点在图块区域范围就好了，请求完善。

qyming2000

谢谢楼主      

yoyoho

谢谢分享!!!!!!

kqqt6236

这个文字转属性块有什么作用呢？