扩展属性查看（原码）不能修改期待大神们进行完善

永不言弃 发表于 2017-9-18 13:29:27

本帖最后由永不言弃于 2017-9-18 13:30 编辑

(defun c:tt ();;;扩展属性
(vl-load-com)
(dcl_project_import
'("YWt6A5ASAADN8azyBuKTKTcxKj9u0B8mZGZmfBTyIE4eil7vM2i9/146XdX0v1ZQ0vTyPnJ0L23w"
"3u7WafMpcQQP8SUywgZOZFGCfm0Je2uLGiJsuNTgm8OA/mdYMPJPiDXBqSEpC8OQ0ISUizWNMAW3"
"Ia2U1vTk1uzIL13JmiA/pdfgZMYRY6vu/fa4bfbsnMe/fcx11u3RfFTYLFTaXLSfhWSjiMsMh7Qf"
"UkNTorSZ1e6FNNcj8ZLacGAlkuX+KVLozstwyCqyhFvS493hexI1UvTjfBA3Me8AIfnIKjrToqm4"
"3TTGOdBGDLcS7Te0bCxw9F8B57E0qx/0idVFGgyUdh5Rntn+eX7he0J4RqAfnD/uVe5B3Iq+BIJ1"
"LeVXSK5bNSk9hN+1ehHQxLHlHFWU//vLAMTb4bhI661vFZahz5pkocyOVBDXpV7BF81ZjB80dh7R"
"slm1DjeS0JhrBWhz40DXYGWD2ijkCCIwF4Yg9QAzEBqpcSxBBY1uoYXX6QRG9uq1prOsSCQ1n1we"
"i0JKGAElaJWKzvj5xEZaxQv21EaOoSuOkRu+KX4hfJJ3RCUR8JR4Al7GF/DRzKfDXqFxBmqSMXuJ"
"q/nZUwNjUuEegrneDQNGZbgByJjdm826EXLXPunUyQKALRxZoPLrNKCUf6AaC/OyZsNwRndG/0+h"
"HaYLq6xotJrE8eOYn1XtI5Pfw3hJaLbGTR4J31sBXMa/vCv8SScmWN5APvJRyZqkIOP7o7y7FJ4o"
"c54kZsFvmppOmfViJX+Vzw/Q4oLiDRVGQbCbg9j5HcgsoTKsgj9kmbMwnQ6P+Mo4ZF2z76iv9Cna"
"SaxhrX3YcTJRb7rBqMm7wbCD5iASAmZpgw6Xe61vjHmtNcYKajvAF2ITwPdKK70imiWUBES2+dxA"
"CMR6GBrSzeN3wPahvZqnui3t06EJyvL7HxwnyuZmFBeBhxa9iVLBM/cA4ktRL/L60ZsajCuNb4cE"
"sETFl4lRexKdjXiEeYdifwE5xsToj1M7vXSaEeJ6B2l5Uc0LWRINTJ5pmnQeWec7w0sbICUvsYNB"
"QH9nAS6bBrMx2UK1ZNqZls+vWAtpoIZY+qvpXxptRLAY4ZdFtOYtiES6dCHnzHjQvSKNO+h8jaAT"
"nuwWWFrh0QKX2fQVRTUkhvktViC71vUtKqqxndPOwG++M/7xfTh84X7ieMaHkUSBwfkBqzf1IUEa"
"hfh+uTwg0HmAIH7AOFXRoX5FyMKFM8DZZ+pmyp3j7/tRsOPrS8gbG8m9sswEK7Eegj3u4fkjco+p"
"z+ay0tcZIXON94rRXfzSl4jJAH9IziGW")
)
(dcl_form_show NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL)
)

(defun c:NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/GraphicButton1#OnClicked (/)
(prompt "\n 选择对象")
(if (setq %%%ssgetobject (ssget))
(progn
   (setq %%knum -1)
   (setq %%enamet (ssname %%%ssgetobject (setq %%knum (1+ %%knum))))

   (setq kzsj (cdr (assoc -3 (entget %%enamet '("*")))))
   (dcl-Control-SetCaption NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/GraphicButton1 (strcat (rtos (1+ %%knum) 2 0) "/" (rtos (sslength %%%ssgetobject) 2 0)))
   (setq %%nuls nil)
   (foreach %ls1 kzsj
;;;(setq %ls1 (nth 0 kzsj))
(setq %ksmc (car %ls1))
(setq %so_l1 nil)
(setq %so_l1 (cons (list %ksmc "") %so_l1))
(foreach %ls2 (cdr %ls1)
;;; (setq %ls2 (nth 0 (cdr %ls1)))
(setq%so_l1 (cons (list (rtos (car %ls2) 2 0)
      (if (= (type (cdr %ls2)) 'STR)
         (cdr %ls2)
         (rtos (cdr %ls2) 2)
      )
      (cond
         ((= (type (cdr %ls2)) 'STR)
         "文本"
         )
         ((= (type (cdr %ls2)) 'INT)
         "整型"
         )
         ((= (type (cdr %ls2)) 'REAL)
         "浮点"
         )
         (t
         ""
         )
         )
      )
      %so_l1
      )
)
)
(setq %%nuls (cons (reverse %so_l1)%%nuls))
)
   (setq %%nuls (reverse %%nuls))

;;;    (dcl_grid_filllist NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1 %%nuls)
   (dcl-Grid-Clear NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1)
   (setq %hh -1)
   (foreach %str1 %%nuls
;;;(setq %str1 (car %%nuls))
(setq %str2 (car %str1))
(dcl-Grid-AddString NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1(strcat (car %str2) "\t" (cadr %str2) "\t文本"))
(setq %hh (1+ %hh))
(foreach %str3 (cdr %str1)
(dcl-Grid-AddString NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1(strcat (car %str3) "\t" (cadr %str3) "\t" (nth 2 %str3)))
(setq %hh (1+ %hh))
(dcl_grid_setcellstyle NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1 %hh 1 6)
)
)

   )
)
(princ)
)

(defun c:NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/TextButton1#OnClicked (/);;;上
(setq %%knum (1- %%knum))
(if (< %%knum 0)
(setq %%knum 0)
)
(setq %%enamet (ssname %%%ssgetobject %%knum))


(setq kzsj (cdr (assoc -3 (entget %%enamet '("*")))))
   (dcl-Control-SetCaption NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/GraphicButton1 (strcat (rtos (1+ %%knum) 2 0) "/" (rtos (sslength %%%ssgetobject) 2 0)))
   (setq %%nuls nil)
   (foreach %ls1 kzsj
;;;(setq %ls1 (nth 0 kzsj))
(setq %ksmc (car %ls1))
(setq %so_l1 nil)
(setq %so_l1 (cons (list %ksmc "") %so_l1))
(foreach %ls2 (cdr %ls1)
;;; (setq %ls2 (nth 0 (cdr %ls1)))
(setq%so_l1 (cons (list (rtos (car %ls2) 2 0)
      (if (= (type (cdr %ls2)) 'STR)
         (cdr %ls2)
         (rtos (cdr %ls2) 2)
      )
      (cond
         ((= (type (cdr %ls2)) 'STR)
         "文本"
         )
         ((= (type (cdr %ls2)) 'INT)
         "整型"
         )
         ((= (type (cdr %ls2)) 'REAL)
         "浮点"
         )
         (t
         ""
         )
         )
      )
      %so_l1
      )
)
)
(setq %%nuls (cons (reverse %so_l1)%%nuls))
)
   (setq %%nuls (reverse %%nuls))

;;;    (dcl_grid_filllist NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1 %%nuls)
   (dcl-Grid-Clear NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1)
   (setq %hh -1)
   (foreach %str1 %%nuls
;;;(setq %str1 (car %%nuls))
(setq %str2 (car %str1))
(dcl-Grid-AddString NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1(strcat (car %str2) "\t" (cadr %str2) "\t文本"))
(setq %hh (1+ %hh))
(foreach %str3 (cdr %str1)
(dcl-Grid-AddString NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1(strcat (car %str3) "\t" (cadr %str3) "\t" (nth 2 %str3)))
(setq %hh (1+ %hh))
(dcl_grid_setcellstyle NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1 %hh 1 6)
)
)
(princ)
)

(defun c:NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/TextButton2#OnClicked (/);;;;下
(setq %%knum (1+ %%knum))
(if (> %%knum (1- (sslength %%%ssgetobject)))
(setq %%knum (1- (sslength %%%ssgetobject)))
)
(setq %%enamet (ssname %%%ssgetobject %%knum))
   =

(setq kzsj (cdr (assoc -3 (entget %%enamet '("*")))))
   (dcl-Control-SetCaption NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/GraphicButton1 (strcat (rtos (1+ %%knum) 2 0) "/" (rtos (sslength %%%ssgetobject) 2 0)))
   (setq %%nuls nil)
   (foreach %ls1 kzsj
;;;(setq %ls1 (nth 0 kzsj))
(setq %ksmc (car %ls1))
(setq %so_l1 nil)
(setq %so_l1 (cons (list %ksmc "") %so_l1))
(foreach %ls2 (cdr %ls1)
;;; (setq %ls2 (nth 0 (cdr %ls1)))
(setq%so_l1 (cons (list (rtos (car %ls2) 2 0)
      (if (= (type (cdr %ls2)) 'STR)
         (cdr %ls2)
         (rtos (cdr %ls2) 2)
      )
      (cond
         ((= (type (cdr %ls2)) 'STR)
         "文本"
         )
         ((= (type (cdr %ls2)) 'INT)
         "整型"
         )
         ((= (type (cdr %ls2)) 'REAL)
         "浮点"
         )
         (t
         ""
         )
         )
      )
      %so_l1
      )
)
)
(setq %%nuls (cons (reverse %so_l1)%%nuls))
)
   (setq %%nuls (reverse %%nuls))

;;;    (dcl_grid_filllist NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1 %%nuls)
   (dcl-Grid-Clear NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1)
   (setq %hh -1)
   (foreach %str1 %%nuls
;;;(setq %str1 (car %%nuls))
(setq %str2 (car %str1))
(dcl-Grid-AddString NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1(strcat (car %str2) "\t" (cadr %str2) "\t文本"))
(setq %hh (1+ %hh))
(foreach %str3 (cdr %str1)
(dcl-Grid-AddString NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1(strcat (car %str3) "\t" (cadr %str3) "\t" (nth 2 %str3)))
(setq %hh (1+ %hh))
(dcl_grid_setcellstyle NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1 %hh 1 6)
)
)
(princ)
)

(defun c:NEWDXTEXTBZOPDCL/NEWDXTEXTBZOPDCL/Grid1#OnEndLabelEdit (Row Column /)
(prompt "只能查看不能修改，期待大神们进行修改")
(princ)

)

血司发表于 2017-9-18 15:07:23

前排赞:lol

li809 发表于 2017-9-19 17:18:59

过来学习，还是看不懂。

fangmin723 发表于 2017-9-20 08:12:10

; 错误: no function definition: DCL_PROJECT_IMPORT

永不言弃 发表于 2017-9-20 09:25:20

fangmin723 发表于 2017-9-20 08:12
; 错误: no function definition: DCL_PROJECT_IMPORT

要加载OPENDCL

fangmin723 发表于 2017-9-20 10:39:27

永不言弃发表于 2017-9-20 09:25
要加载OPENDCL

怎么加载？？？

vectra 发表于 2017-9-20 14:03:34

看到这个帖子专门写了个小工具，传送门

http://bbs.mjtd.com/thread-175538-1-1.html

永不言弃 发表于 2017-9-20 16:06:34

vectra 发表于 2017-9-20 14:03
看到这个帖子专门写了个小工具，传送门

http://bbs.mjtd.com/thread-175538-1-1.html

非常感谢{:1_1:}

页: [1]

明经CAD社区's Archiver

扩展属性查看（原码）不能修改期待大神们进行完善