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

LUCAS · 发表于 2002-12-13 16:11:25

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;把text转为属性图块
;;By LUCAS
(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 (rtos (* (getvar "CDATE") 1E8)))
(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)

;;把text转为属性图块 
;;By LUCAS 
(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 (rtos (* (getvar "CDATE") 1E8))) 
  (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)

aichong · 发表于 2006-2-9 17:22:47

把text转为属性图块有什么好处？

aleopard · 发表于 2006-5-31 10:39:36

上面的错了，文本中不能有空格，有空格和转化不了。

weishi12 · 发表于 2006-6-1 18:23:52

什么叫文本中不能有空格。倒是在不同语言的操作系统中显示文字有帮助。下载来试一下。

gc15 · 发表于 2006-9-1 22:05:47

有点意思

xiaobai924 · 发表于 2006-9-26 13:50:14

请问，这个跟以前的单行文字有什么区别吗？

jx2008 · 发表于 2006-11-21 18:57:50

改称一个函数吧，用以调用

killer9806 · 发表于 2007-2-5 09:02:54

可以随时做属性块哦，谢楼主提供

wyzcm · 发表于 2007-4-7 15:49:39

找了好久,终于让我找到了,正好能用上,谢谢

yu4210611 · 发表于 2007-4-9 12:41:18

学习学习

li809 · 发表于 2007-4-14 23:01:21

下来用用看看是什么效果的

szbld · 发表于 2007-6-28 15:21:57

谢谢,共享

zqwx · 发表于 2007-7-18 18:34:47

偶的一个图，炸开后文字旧消失了，郁闷

zzqxuexicad · 发表于 2007-8-10 14:52:09

不错

fengsea · 发表于 2007-11-20 00:14:31

找了好久，平常做属性块相对比较繁琐，能否支持下多行文字，还有要是能完善下标记/提示/值这三个值中有个对话框dcl能进行详细的补充和能输入属性块的名称的选项那就完美了！！

账号		自动登录	找回密码
密码			立即注册

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

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子