块分解后如何写入扩展数据
本帖最后由 yhly555 于 2015-12-17 08:11 编辑存在问题：dwg图中红色块分解后如何写入扩展数据，白色块分解后却不能，不知道为什么？请高手帮忙，谢谢！;存在问题：dwg图中红色块分解后可以写入扩展数据，白色块分解后却不能，不知道为什么？请高手帮忙，谢谢！
(defun c:bn ()
(setq ss (ssget '((0 . "INSERT"))) Index 0)
(repeat (sslength ss)
(setq Ename (ssname ss Index))
(setq Index (1+ Index))
(command "_EXPLODE" Ename)
(princ (entlast))
(TTEDIT (entlast) "AAA" (cons 1000 "写入的扩展数据" ) "ALL") ;地块标志符
)
)
(vl-load-com)
;;;=============================================
;;; 通用函数 扩展数据的添加
;;;参数：en ----对象图元名
;;; app_name ----扩展应用名
;;; v1 ----值
;;; STR ----操作标识。含义如下：
;;; "DelOnly"删除指定应用名的扩展数据，不添加
;;; "DelAll" 删除所有应用名的扩展数据，不添加
;;; "Add" 不覆盖现有扩展数据，添加新的数据
;;; "Del" 删除指定应用名下的扩展数据，添加新的数据
;;; "All" 删除所有应用名下的扩展数据，添加新的数据
;;;日期：zml84 修改于 2013-07-18
(defun TTEDIT (EN APP_NAME V1 STR / ENL TMP TMP1 TMP2)
;;转换为大写
(setq STR (strcase STR))
;;
(cond
;;1.删除指定应用名的扩展数据
((= STR "DELONLY")
(setq ENL (entget EN (list APP_NAME)))
(if (assoc -3 ENL)
(entmod (subst (list -3 (list APP_NAME)) (assoc -3 ENL) ENL)
)
)
)
;;2.删除原来所有的扩展数据
((or (= STR "DELALL")
(= STR "ALLDEL")
)
(setq ENL (entget EN (list "*")))
(setq TMP (cdr (assoc -3 ENL)))
;;逐个删除
(foreach N TMP
(TTEDIT EN (car N) NIL "DELONLY")
)
)
;;3.不操作任何扩展数据（如果注册的是已有的也不覆盖）
((or (= STR "ADD")
(= STR "")
)
(setq ENL (entget EN (list APP_NAME)))
(setq TMP (cdr (assoc -3 ENL)))
(setq TMP1 (cdr (assoc APP_NAME TMP)))
(if TMP1
(setq TMP2(append TMP1 (list V1))
ENL(subst (list -3 (cons APP_NAME TMP2)) (assoc -3 ENL) ENL)
)
(setq ENL (append ENL (list (list -3 (list APP_NAME V1)))))
)
(regapp APP_NAME);;更新
(entmod ENL)
)
((= STR "DEL");;4.删除当前，添加新的数据
(TTEDIT EN APP_NAME NIL "DELONLY");;删除原来所有的扩展数据
(TTEDIT EN APP_NAME V1 "ADD");;添加新的数据
)
((= STR "ALL");;5.删除原来所有的扩展数据，添加新的数据
(TTEDIT EN NIL NIL "DELALL");;删除原来所有的扩展数据
(TTEDIT EN APP_NAME V1 "ADD");;添加新的数据
)
) ;_结束COND
)
页:
[1]