[LISP]请教：我的扩展数据这样不行吗？有没有别的办法给一个实体附几个？

我爱lisp

(regapp APID)
(setq dlist    (list (cons 1000 T1)
                      (cons 1000 T2)
                      (cons 1040 T3)
                      (cons 1040 T4)
                      (cons 1040 T5)
                      (cons 1040 T6)  )
TMP1 (list -3 (cons APID DLST)
我想给一个实体加多个扩展数据，只用一次注册，请问还有什么好办法呢？
先谢一下！

hl2006

大神些，这个咋用呢

meflying

几个扩展数据是指什么？
如果是几个应用名，那你要加什么就注册什么啊，一次注册，怎么知道你以后还要增加什么，
你改变APID及T？的值循环几次就可以了，又不复杂，程序也不会慢

注册是对应扩展数据的应用名的，不是对应对象的

我爱lisp

感谢meflying！！
我主要是觉得多次注册应用程序访问可能麻烦点。
还想请教一下：我上面那样一个应用名下多次使用1000或1040行不行？

lockmyeye

1000是可以的，我经常用它来保存属性数据。
1040不知道行不行，我想也是可以的。不过你用到的时候可能区分不开。

以下是我使用1000的实体属性数据：
((-1 . <Entity name: 2a70e90>) (0 . "MTEXT") (5 . "254A") (100 . "AcDbEntity") (67 . 0) (8 . "图斑地类号") (62 . 6) (100 . "AcDbMText") (10 -349.776 -273.313 0.0) (40 . 10.0) (41 . 0.0) (71 . 5) (72 . 5) (1 . "\\S1/201;") (7 . "图斑地类号") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 16.25) (43 . 23.3333) (50 . 0.0) (-3 ("LAND_UPDATE" (1000 . "手簿页码,11") (1000 . "图斑,,,201,,120,441481100003,,,,1,,,,,,,,,,,,,F,F"))))

实体有多种属性，每个属性表使用一个1000代码表示。表内字段我使用逗号进行分隔，第一个字段定义为属性表名。使用起来还是挺方便的。

lockmyeye

1. 程序代码内容

复制代码

;;;数据格式说明

;;;        程序间接口使用格式         ((1 "string1") (2 "string2") (3 "string3") (x "string..."))
;;;        中间能使用到的格式         ("string1" "string2" "string3" "string...")
;;;        数据存储时使用格式         (-3 ("Land_Update" (1000 . "属性表名1,string1,string2,string3,string...")(1000 . "属性表名2,string1,string2,string3,string...")(1000 . "属性表名3,string1,string2,string3,string...")(1000 . "属性表名x,string1,string2,string3,string...")))

;;;================================================================================================
;;;分本分解程序

;;;进入
;;;fj_text        字符串        要分解的文本
;;;fj_char 字符串        分隔符,可以是定义多个字符，但在fj_text中以单个分隔
;;;fj_lx        逻辑        是否把连续多个的分隔符当一个理
;;;fj_not_null        逻辑        是否去掉空的数据

;;;局部变量
;;;xj_result        字符串的表        分解结果
;;;char_place        整数        当前字符位置
;;;fj_char_found        逻辑        上一个字符是否是分隔符
;;;char_now        字符        当前字符
;;;char_old        字符串        没有写入的符

;;;返回
;;;fj_result        以字符串为原子的表,分解结果
(defun explode_text(fj_text fj_char fj_lx fj_not_null / fj_result char_place fj_char_found char_now char_old)
        (setq fj_result nil)
        (setq char_place 1)
        (setq fj_char_found nil)
        (setq char_old "")
        (repeat (if fj_text (strlen fj_text) 0)
                (setq char_now (substr fj_text char_place 1) char_place (1+ char_place))
                (if (wcmatch fj_char (strcat "*`" char_now "*"))
                        (progn
                                (if (not (and fj_lx fj_char_found))
                                        (progn
                                                (if (not (and fj_not_null (= "" char_old)))
                                                        (setq fj_result (append fj_result (list char_old)))
                                                )
                                                (setq char_old "")
                                        )
                                )
                                (setq fj_char_found t)
                        )
                        (progn
                                (setq char_old (strcat char_old char_now))
                                (setq fj_char_found nil)
                        )
                )
        )
        (if (not (and fj_not_null (= "" char_old)))
                (setq fj_result (append fj_result (list char_old)))
                (setq fj_result fj_result)
        )
)
;;;文本分解逆程序
;;;形参
;;;        fj_result        以字符串为原子的表,分解结果
;;;        fj_char 字符        分隔符,只可以是定方单个分隔
;;;返回
;;;        unfj_result        字符串,逆分解结果
(defun unexplode_text(fj_result fj_char / unfj_result one)
        (setq unfj_result "")
        (foreach one fj_result
                (setq unfj_result (strcat unfj_result fj_char one))
        )
        (setq unfj_result (substr unfj_result 2))
)
;;;================================================================================================
;;;字符串表的变换形式

;;;如果入口参数为        ("string1" "string2" "string3" "string...")        则转换为        ((1 "string1") (2 "string2") (3 "string3") (x "string..."))
;;;如果入口参数为        ((1 "string1") (2 "string2") (3 "string3") (x "string..."))        则转换为        ("string1" "string2" "string3" "string...")
;;;如果入口参数不是以上，则直接退出
(defun text_table_exchange (text_table / one result num temp)
    (setq result (list))
    (setq temp (type (car text_table)))
    (setq num 1)
    (cond ((= 'STR temp)
           (foreach one text_table (setq result (append result (list (list num one)))) (setq num (1+ num)))
          )
          ((= 'List temp)
           (foreach one        text_table
               (if (and (= 2 (length one)) (= num (car one))) ;两项表
                   (setq result (append result (list (cadr one))))
                   (*error* "在<text_table_exchange>中出现未明的数据格式，请检查参数!") ;其它表
               )
               (setq num (1+ num))
           )
          )
          (t (*error* "在<text_table_exchange>中出现未明的数据格式，请检查参数!"))
    )
    (setq result result)                          ;返回结果
)

;;;================================================================================================

;;;读取实体的Land_Update扩展属性的子函数
;;;得到实体所有的Land_Update扩展属性数据
;;;

;;;ent                要得到Land_Update扩展属性数据的实体名
;;;局部变量
;;;Feature        Land_Update扩展属性数据表
;;;返回格式如
;;;(
;;;    ("属性表名1" ((1 "string1") (2 "string2") (3 "string3") (x "string...")))
;;;    ("属性表名2" ((1 "string1") (2 "string2") (3 "string3") (x "string...")))
;;;    ("属性表名3" ((1 "string1") (2 "string2") (3 "string3") (x "string...")))
;;;    ("属性表名x" ((1 "string1") (2 "string2") (3 "string3") (x "string...")))
;;;)
(defun get_land_update_feature_sub1 (ent / feature one result)
    (setq feature (cdr (assoc "LAND_UPDATE" (cdr (assoc '-3 (entget ENT '("Land_Update")))))))
    (setq result nil)                                  ;返回数据
    (foreach one feature
        (if (= '1000 (car one))
            (progn (setq one (cdr one))                  ;提取land_update的单个属性表
                   (setq one (explode_text one "," nil nil))
                   (setq result (cons (cons (car one) (list (text_table_exchange (cdr one)))) result))
            )
        )
    )
    (setq result result)
)

;;;================================================================================================
;;;获取指定实体的特定的表属性数据
;;;ent                要得到Land_Update扩展属性数据的实名
;;;table_name        Land_Update扩展属性数据的表名
;;;返回格式如下
;;;((1 "string1") (2 "string2") (3 "string3") (x "string..."))
(defun get_land_update_feature (ent table_name / feature)
;;;以下部分可能使用太频繁了，可能会使程序运行速度降低，暂时取消判断
;;;    (if        (or
;;;            (/= 'ENAME (type ent))
;;;            (/= 'STR (type table_name))
;;;        )
;;;        (*error* "get_land_update_feature的参数类型不对。")
;;;    )
    (setq feature (get_land_update_feature_sub1 ent))
    (if        (setq feature (assoc table_name feature))
        (setq feature (cadr feature))
    )
)

;;;;;;================================================================================================

;;;设置实体的Land_Update扩展属性

;;;形参
;;;ent                要修改的实体名
;;;feature        Land_Update数据的单个属性表        格式如("属性表名" ((1 "string1") (2 "string2") (3 "string3") (x "string...")))
;;;局部变量         
;;;data                ent的实体数据
(defun put_land_update_feature (ent feature / data feature_all one temp)
;;;以下部分可能使用太频繁了，可能会使程序运行速度降低，暂时取消判断
;;;    (if        (or
;;;            (/= 'ENAME (type ent))
;;;            (/= 'LIST (type feature))
;;;        )
;;;        (*error* "put_land_update_feature的参数类型不对。")
;;;    )
    ;;得到所有的Land_Update扩展属性表
    (setq feature_all (get_land_update_feature_sub1 ent))
    ;;更新或者生成新的Land_Update扩展属性表
    (if        (assoc (car feature) feature_all)
        (setq feature_all (subst feature (assoc (car feature) feature_all) feature_all))
        (setq feature_all (cons feature feature_all))
    )
    ;;提取不是1000的属性
    (setq feature nil)
    (foreach one (cdr (assoc '"LAND_UPDATE" (cdr (assoc '-3 (entget ent '("LAND_UPDATE"))))))
        (if (/= '1000 (car one))
            (if        feature
                (setq feature (cons one feature))
                (setq feature (list one))
            )
        )
    )
    ;;加入1000的属性表
    (foreach one feature_all
        (setq temp (strcat (car one) "," (unexplode_text (text_table_exchange (cadr one)) ",")))
        (if (> 256 (strlen temp))
            (setq feature (cons (cons 1000 temp) feature))
            (*error* (strcat "Land_Update的扩展属性组码1000所带的数据<" temp ">长度大于255。"))
        )
    )
    (setq feature (list (list -3 (cons "Land_Update" feature))))
    (setq data (append (entget ent) feature))
    (if        (not (entmod data))
        (progn (alert "错误:\n\t不能更新Land_Update扩展属性数据!\t"))
    )
)

;;;================================================================================================
;;;删除指定实体的Land_Update某一扩展属性
(defun del_land_update_feature (ent table_name / data feature_all one feature)
    (if        (or (/= 'ENAME (type ent)) (/= 'STR (type table_name)))
        (*error* "函数<del_land_update_feature>的参数类型错误。")
    )
    (setq table_name (strcase table_name))
    (setq feature_all (get_land_update_feature_sub1 ent))
    (setq feature nil)                                  ;返回数据
    (foreach one feature_all
        (if (/= (strcase (car one)) table_name)
            (if        (> 256
                   (strlen (setq temp (strcat (car one) "," (unexplode_text (text_table_exchange (cadr one)) ","))))
                )
                (setq feature (cons (cons 1000 temp) feature))
                (*error* (strcat "Land_Update的扩展属性组码1000所带的数据<" temp ">长度大于255。"))
            )
        )
    )
    ;;加入不是1000的属性
    (foreach one (cdr (assoc '"LAND_UPDATE" (cdr (assoc '-3 (entget ent '("LAND_UPDATE"))))))
        (if (/= '1000 (car one))
            (setq feature (cons one feature))
        )
    )
    ;;更新扩展属性
    (setq feature (list (list -3 (cons "Land_Update" feature))))
    (setq data (append (entget ent) feature))
    (if        (not (entmod data))
        (progn (alert "错误:\n\t不能更新Land_Update扩展属性数据!\t"))
    )
)

meflying

我爱lisp发表于2003-10-27 22:10:00感谢meflying！！
我主要是觉得多次注册应用程序访问可能麻烦点。
还想请教一下：我上面那样一个应用名下多次使用1000或1040行不行？

都可以的

BDYCAD

我也寫了一個但好象不用這樣長啊. 另外我想請教樓主的擴充數據主要用在什麼地方. 我很少用. 所以不是很了解它的應用. 謝謝.

lockmyeye

程序长是因为我使用到多个属性表和属性表本身的生成、更新和删除。

我现在用它来保存属性数据，使用1000。
或者两个实体之间建立一种指向关系，使用1005。

我爱lisp

非常感谢！

我爱lisp

扩展数据可以用来给实体如线，块等附加一些信息，对于地图，信息，工程等都可以用到，大大的丰富了CAD的功能。当然是在二次开发后了。