求帮忙,让它能实现
①对象扩展数据的读取时,对象有内容时显示原内容,多个对象时,相同则显示内容,不同显示为*
②对多个对象时,批量写入

;;查看/增加/编辑扩展数据
(defun C:ccc ( / allexdata dcl_id editlabel entdata entgrp  exdata m n ss
                                                                                 newallexdata newexdata fn result val_lst value entname tmp
                                                                         )
  (defun getentdxf (ent dxf)
    (cdr (assoc dxf (entget ent '("*"))))
  )
  (defun add_dclrow (dstr) (if dstr (setq val_lst (cons dstr val_lst))))
  (defun getdclvalue ()
    (setq n 1)
    (setq newallexdata '())
    (foreach exdata allexdata
      (setq newexdata '())
      (repeat (length (cdr exdata))
        (setq newexdata (append (list (cons 1000 (get_tile (strcat "eb" (itoa n))))) newexdata))
        (setq n (1+ n))
      )
      (setq newallexdata (append (list (cons (car exdata) (reverse newexdata))) newallexdata))
    )
    (setq newallexdata (cons -3 (reverse newallexdata)))
  )
       
                (setq val_lst nil)
        ;;Dcl文件
                (setq editlabel (strcat (getenv "temp") "\\editlabel.dcl"))
    (add_dclrow "editlabel:dialog{label=\"编辑扩展数据\";")
    (add_dclrow ":row{")
                (add_dclrow (strcat ":boxed_column{label=\"XData" "\";"))
                (add_dclrow (strcat ":edit_box{label=\"编号" "\";key=\"eb1\" ;width=30;}"))
                (add_dclrow (strcat ":edit_box{label=\"名称" "\";key=\"eb2\" ;width=30;}"))
                (add_dclrow (strcat ":edit_box{label=\"规格"  "\";key=\"eb3\" ;width=30;}"))
                (add_dclrow (strcat ":edit_box{label=\"备注"  "\";key=\"eb4\";width=30;}"))
                (add_dclrow "}")
    (add_dclrow "}ok_cancel;}")
    (setq fn (open editlabel "w"))
    (foreach n (reverse val_lst) (write-line n fn))
    (close fn)
    (if (< (setq dcl_id (load_dialog editlabel))
                                        0
        )
      (exit)
    )
    (if (not (new_dialog "editlabel" dcl_id))
      (exit)
    )
       
        (setq n 1)
        (foreach exdata allexdata
                (setq m 1)
                (repeat (length (cdr exdata))
                        (if (= (type (cdr (nth (1- m) (cdr exdata)))) 'STR)
                                (setq value (cdr (nth (1- m) (cdr exdata))))
                                (setq value (rtos (cdr (nth (1- m) (cdr exdata)))))
                        )
                        (set_tile (strcat "eb" (itoa n)) value)
                        (setq m (1+ m))
                        (setq n (1+ n))
                )
        )
        (action_tile "accept" "(done_dialog 1)")
        (action_tile "cancel" "(done_dialog 0)")
        (setq result (start_dialog))
        (cond
                ((= 1 result)
                        (if (setq ss (LM:ssget "\n 选取扩展数据对象" nil ))
                                (while (setq entname (ssname ss 0))
                                        (setq ss (ssdel entname ss))
                                        (getdclvalue)
                                        (if (getentdxf entname -3)
                                                (setq allexdata (getentdxf entname -3))
                                                (progn
                                                        (regapp "XData")
                                                        (setq allexdata '(("XData" (1000 . "")(1000 . "")(1000 . "")(1000 . ""))))
                                                )
                                        )                                       
                                        (setq entdata (entget entname '("*")))
                                        (if (getentdxf entname -3)
                                                (entmod (subst newallexdata (assoc -3 entdata) entdata))
                                                (entmod (append entdata  (list newallexdata)))
                                        )
                                )   
                        )
                )
        )
        (princ)
)

网友答: 我来考古!!!
  • 上一篇:分享我自学四个月lisp收集的资料,此链接也在我
  • 下一篇:没有了