liuningdsb 发表于 2018-1-2 19:21
怎样做清空和全选按钮啊，求代码
呵呵，我也不知道怎么弄
如果能支持刷内容 刷宽度 高度 字体样式等就更完美了
如果能支持刷内容 刷宽度 高度 字体样式等就更完美了
给楼主点个赞。
谢谢楼主分享
学习学习，很实用的功能
;;;功能：属性刷子
(vl-load-com)
(defun C:KN (/ SS ID ID2ENTBLOCK ENTDATA I LST2 LST1 )
(if(and (setq SS (entsel "\n点取源对象: "))
(setq ENT (GetAttributes (car SS)))
(SSS-MAKE-DCL ENT "d:\\test.dcl")
(>= (setq ID (load_dialog "d:\\test.dcl")) 0)
)
(progn
(setq LST1 '())
(new_dialog "sxk_sss" ID)
(action_tile"Command1" "(TT1)")
(action_tile"Command2" "(TT2)")
(setq ID2 (start_dialog))
(print LST1)
(princ "\n>>>>>>>>>>id2=")
(princ ID2)
(setq lst2(mapcar '(lambda (x) (nth x ENT)) LST1))
(setq lst2(mapcar '(lambda (x) (cadr x)) LST2))
(princ "\n要刷同的是:")(princ lst2)
(if (and (= ID2 1) (> (length LST2) 0))
(if (setq SS1 (ssget '((0 . "INSERT"))));选择目标块
(foreach tagname LST2
(setq value (getattvalue (car SS) tagname));取得源块tag的属性值
(repeat
(setq i (sslength SS1));目标块数量
(setattvalue (ssname SS1 (setq i (1- i))) tagname value);修改目标块tag的属性值
)
)
)
)
;;卸载对话框文件
(unload_dialog ID)
(vl-file-delete"d:\\test.dcl")
)
)
(princ)
)
;;;[功能]根据ENT表，生成DCL文件
(defun SSS-MAKE-DCL(ENT FILENAME / F1 I)
(if(setq F1 (open FILENAME "w"))
(progn
(write-line "sxk_sss: dialog\n{\n key = \"DLG_NAME\"; \nlabel = \"属性块刷子\";" F1 )
(write-line " :row{" F1)
(write-line ":boxed_column\n{\nlabel=\"对象特性:\";"F1)
(setq I 0)
(foreach N ENT
(progn
(write-line (strcat":toggle\n{ label=\""
(vl-princ-to-string( Cadr N))
"\"" ";key = \"" (itoa I) "\";\nwidth=20;\nvalue=\"0\";"
"action=\"(TT" " " (itoa I) ")\";}")
F1 )
(setq I (1+ I))
)
);;;结束foreach
(write-line "\n}" F1);;;结束boxed_column
(write-line " :column{" F1)
(write-line " :button{key = \"Command1\" ; label = \"全选\" ; width = 10 ;height = 1.5 ; }" F1)
(write-line " :button{key = \"Command2\" ; label = \"全部取消\" ; width = 10 ;height = 1.5 ; }" F1)
(write-line "\nok_only;" F1)
(write-line "\n}" F1);;;column
(write-line "\n}" F1);;;row
(write-line "\n}" F1);;;结束dialog
(close F1)
t
);;;结束progn
);;;结束if
)
;;;action 函数
(defun TT (INT)
(if (= $VALUE "1")
(setq LST1 (cons INT LST1));将INT添加到表LST1
(setq LST1 (vl-remove INT LST1))
)
)
;;;全选 action 函数
(defun TT1 ( / j)
(setq j 0)
(while(<j (length ENT ))
(set_tile (itoa j) "1")
(setq LST1 (cons j LST1))
(setq j (1+ j))
)
)
;;;全部取消 action 函数
(defun TT2 (/ j)
(setq j 0)
(while(<j (length ENT ))
(set_tile (itoa j) "0")
(setq LST1 '())
(setq j (1+ j))
)
)
;;;取得图元属性
(defun getattributes (ent / lst r)
(while (=(cdr (assoc 0 (setq lst (entget (setq ent (entnext ent))))))
"ATTRIB" )
(setqr(cons
(mapcar 'cdr (mapcar 'assoc '(-1 2 1) (list lst lst lst)))
r)
)
(reverse r)
)
)
;;;取得块属性值
(defun getattvalue (entblock attname / entdata entname test value)
(setq entname entblock test t)
(while (andtest (setq entname (entnext entname)))
(setq entdata (entget entname))
(cond
((not (= (cdr (assoc 0 entdata)) "ATTRIB")) (setq test nil))
((= "SEQEND" (cdr (assoc 0 entdata))) (setq test nil))
((= (cdr (assoc 2 entdata)) attname) (setq value (cdr (assoc 1 entdata))))
)
)
value
)
;;;getattnamelst 替换getattributes
;;;给块属性赋值
(defun setattvalue (EN ATTNAME vALUE /szb1 E TEST ENT)
(setq E EN RETURN NIL TEST t )
(while (and TEST (setq E (entnext E)) )
(setq ENT (entget E))
(cond
;;
((not (= (cdr (assoc 0 ENT)) "ATTRIB"))
(setq TEST NIL)
)
;;
((= "SEQEND" (cdr (assoc 0 ENT)))
(setq TEST NIL)
)
;;
((= (cdr (assoc 2 ENT)) ATTNAME )
(setq ENT (subst (cons 1 VALUE)(assoc 1 ENT) ENT) )
(entmod ENT)
(entupd EN)
(setq RETURN t)
)
) ;_结束cond
)
;;返回
RETURN
)
半懂不懂调试了3天，终于能用了
调试中学习到不少东西，感谢分享
38楼的块属性刷，速度有点慢
好帖好报，谢谢分享