通信人家园

标题: 一次关于CAD的二次开发 [查看完整版帖子] [打印本页]

时间: 2020-7-9 01:44

作者: sihutong 标题: 一次关于CAD的二次开发

(defun c:tee (/ allexdata dcl_id editlabel entdata entgrp entname exdata m n
newallexdata newexdata nn result val_lst value
      )
  (prompt "查看/增加/编辑扩展数据")
  (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)))
  )
  ;(saverror)
  (if (setq entgrp (cadr (ssgetfirst)))
   (if (= (sslength entgrp) 1)
   (setq entname (ssname entgrp 0))
   )
   (setq entname (car (entsel "\n 请选择要编辑扩展数据的对象: ")))
  )
  (while entname
(setq val_lst nil)
(if (getentdxf entname -3)
   (setq allexdata (getentdxf entname -3))
   (progn
      (regapp "SunXApp")
      (setq allexdata '(("SunXApp" (1000 . "")(1000 . "")(1000 . "")(1000 . ""))))
   )
)
(setq editlabel (strcat (getenv "temp") "\\editlabel.dcl"))
(add_dclrow "editlabel:dialog{label=\"编辑标签\";")
(add_dclrow ":row{")
(setq n 1)
(foreach exdata allexdata
   (add_dclrow (strcat ":boxed_column{label=\"" (car exdata) "\";"))
   (setq m 1)
   (repeat (length (cdr exdata))
      (add_dclrow (strcat ":edit_box{label=\"标签" (itoa m) "\";key=\"eb" (itoa n) "\";width=30;}"))
      (setq m (1+ m))
      (setq n (1+ n))
   )
   (add_dclrow "}")
)
(add_dclrow "}ok_cancel;}")
(setq nn (open editlabel "w"))
(foreach n (reverse val_lst) (write-line n nn))
(close nn)
(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" "(getdclvalue)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq result (start_dialog))
(cond
   ((= 1 result)
      (setq entdata (entget entname '("*")))
      (if (getentdxf entname -3)
      (entmod (subst newallexdata (assoc -3 entdata) entdata))
      (entmod (append entdata  (list newallexdata)))
      )
   )
)
(setq entname (car (entsel "\n 请选择要编辑扩展数据的对象: ")))
  )
  ;(restore)
  (princ)
)

通信人家园 (https://www.txrjy.com/)