这把刷子如何刷线宽
本帖最后由 注册 于 2013-7-6 10:08 编辑;;我也会编程, 可自由定制的最强劲的刷子 ;;==============================================================;; ;; Writen By Eachy Email: eachy@21cn.com 2004.12.23 ;; ;; homepage: www.xdcad.net ;; ;;==============================================================;;获取某一个实体所有可用属性petersciganek ;;http://discussion.autodesk.com/thread.jspa?messageID=3941641;;==============================================================(defun f:vl-property-available (en)(setq en (f:enx en)) (vl-remove-if-not (function (lambda (x) (vlax-property-available-p en x t))) (f:vla-getlist) ))(defun f:vla-getlist ()(cond (*vla-getlist*) ((setq *vla-getlist* (mapcar (function (lambda (x) (substr x 9))) (vl-remove-if-not (function (lambda (x) (wcmatch (strcase x) "VLA-GET-*"))) (atoms-family 1)) ) ) ;setq )))(defun f:vla-methodlist ()(cond (*vla-methodlist*) ((setq *vla-methodlist* (mapcar (function (lambda (x) (substr x 5))) (vl-remove-if-not (function (lambda (x) (and (wcmatch (strcase x) "VLA-*") (not (wcmatch (strcase x) "VLA-GET-*,VLA-PUT-*")) ) ;and ) ) (atoms-family 1) ) ) ) ;setq )) ;cond)(defun f:vl-method-applicable (en)(setq en (f:enx en))(vl-remove-if-not (function (lambda (x) (vlax-method-applicable-p en x))) (f:vla-methodlist)))(defun f:enx (en)(if (= (type en) 'ENAME) (vlax-ename->vla-object en) en));;==============================================================;;产生动态对话框,用户供选择wkai ;;==============================================================(defun zf:get_properties (e pl / DCL_NAME E F FLAG INDEX_VALUE PL1 VAR pl2 pl0 );;;======================================================(defun zf:format_str (a b) (print a) (princ " ") (princ (type a)) (setq a (vl-princ-to-string a)) (if (> (strlen a) b) (setq a (strcat (substr a 1 (- b 1)) ".")) (repeat (- b (strlen a) )(setqa (strcat a " "))) ) a);;;======================================================(defun zf:check_toggles () (foreach n pl0 (if (= "1" (get_tile (vl-princ-to-string (if (listp n)(car n)n)))) (setq pl2 (cons (if (listp n)(car n)n) pl2)) ) ) (done_dialog 1));;;======================================================(defun zf:selectall (str pl1 / mode) (setq mode (get_tile str)) (foreach n pl1 (set_tile (vl-princ-to-string (if (listp n)(car n)n)) mode) ));;;======================================================(defun zf:get_rows(n / lst)(cond ((< n 6)(setq b 1)) ((< n 18)(setq b 2)) (t(setq b 3)) )(setq c (1+ (fix (/ n b 1.0))) m 1)(while (<= m c)(setq r (rem n m))(if (or (= r 0)(> r (* 0.7 m)))(setq lst (cons m lst) ))(setq m (1+ m)))(car lst));;;======================================================(if (= 'ENAME (type e)) (setq e (vlax-ename->vla-object e)))(setq pl (f:vl-property-available e))(foreach n pl (if (not (vl-catch-all-error-p (setq var (vl-catch-all-apply 'vlax-get-property (list e (if (listp n)(car n)n)) ) ) ) ) (setq pl0 (cons n pl0)) ))(setq pl0 (mapcar 'read (vl-sortpl0 '<)))(setq pl1 pl0)(setq pl '((color "Color") (layer "Layer") (linetype "线型") (lineweight "线宽") (LinetypeScale "线型比例") (PlotStyleName "打印样式") （linewidth "多义线宽") ) ;_ 此处可根据需要增减)(foreach n pl (setq pl1 (vl-remove (car n) pl1) ) )(setq m 0 o (zf:get_rows (length pl1)))(or o (setq o 20) )(setq oo (fix(/ (length pl1) o 1.0) ))(if(>(rem (length pl1) o )0)(setq oo (1+ oo)))(setq oo (cadr (assoc oo '((1 6)(2 3)(3 2)(4 2)(5 2)(6 1)))))(or oo (setq oo 1)) (setq DCL_NAME (getvar "TEMPPREFIX"))(setq dcl_name (strcat dcl_name "easy_matchprop" ".dcl"))(SETQ f (OPEN dcl_name "w"))(write-line (strcat "ss:dialog{label=\"" (vlax-get-property e 'ObjectName) "\";" ) f)(write-line ":boxed_row{label=\"Public Props\";\n:column{" f)(foreach n pl (setq m (1+ m)) (if (> m oo) (progn (setq m 1) (write-line "}\n:column{" f)) ) (write-line (strcat ":toggle{label=\"" (zf:format_str (if (listp n) (cadr n) n ) 15 ) ":" (zf:format_str (vlax-get-property e (if (listp n) (car n) n ) ) 15 ) "\";key=\"" (vl-princ-to-string (if (listp n) (car n) n ) ) "\";}" ) f ))(repeat (- oo m)(write-line ":spacer{}" f))(write-line "}}:boxed_row{label=\"Private Props\";\n:column{" f)(setq m 0)(foreach n pl1 (setq m (1+ m)) (if (> m o) (progn (setq m 1) (write-line "}\n:column{" f)) ) (write-line (strcat ":toggle{label=\"" (zf:format_str (if (listp n)(cadr n)n)15)":" (zf:format_str (vlax-get-property e (if (listp n)(car n)n))15) "\";key=\"" (vl-princ-to-string (if (listp n)(car n)n)) "\";}" ) f ))(repeat (- o m)(write-line ":spacer{}" f))(write-line "}}:row{:toggle{label=\"Public Props\";key=\"selectall\";}:toggle{label=\"Private Props\";key=\"selectall1\";}ok_only;}}" f)(close f)(setq index_value (load_dialog dcl_name))(new_dialog "ss" index_value)(action_tile "selectall" "(zf:selectall \"selectall\" pl)")(action_tile "selectall1" "(zf:selectall \"selectall1\" pl1)")(action_tile "accept" "(zf:check_toggles)")(setq flag (start_dialog))(unload_dialog index_value) (print pl2)pl2);;==============================================================;;改特性的一种通用编程方法，变量名称使用特性名，用 eval 求值 ;;==============================================================(defun ea:put-property (obj plst /)(mapcar '(lambda (p) (if (eval p) (vl-catch-all-apply 'vlax-put-property (list obj p (eval p)) ) ) ) plst));;==============================================================;;示例 ;;用上面的函数可以做出比CAD更最强劲的并可以自由定制的刷子 ;; pl 中需要的特性参考联机帮助中各实体 Properties ;;==============================================================(vl-load-com)(defun c:mat (/ e ss obj pl olderr myerr eDoc)(defun myerr (msg) (if (/= msg "取消") (princ "\n*取消*") ) (if pl (progn (mapcar '(lambda (x) (set x nil)) pl) (setq pl nil) ) ) (vla-endundomark eDoc) (setq *error* olderr) (princ))(setq eDoc (vlax-get-property (vlax-get-acad-object) 'activedocument))(vla-startundomark eDoc)(setq olderr *error* *error* myerr)(if (and (setq e (car (entsel "\n选择源对象: "))) (setq pl (zf:get_properties e pl)) (progn (princ "\n选择目标对象....") (setq ss (ssget)) ) ) (progn (setq obj (vlax-ename->vla-object e)) (mapcar '(lambda (p / var) (if (not (vl-catch-all-error-p (setq var (vl-catch-all-apply 'vlax-get-property (list obj p) ) ) ) ) (set p var) (set p nil) ) ) pl ) (setq ssl (sslength ss)) (while (> ssl 0) (setq obj (vlax-ename->vla-object (ssname ss (setq ssl (1- ssl)))) ) (ea:put-property obj pl) ) (mapcar '(lambda (x) (set x nil)) pl) (setq pl nil) ))(setq *error* olderr)(vla-endundomark eDoc)(princ))(princ "\nWriten By Eachy , From www.xdcad.net!")(princ "\nModifiedBy Wkai , From www.xdcad.net!")(princ "\n启动命令: mat")(princ) （linewidth "多义线宽")
这句是我自己加上去的，加上后mat命令无法运行（我已经把命令的简写从ea：mat改到了mat），源程序是由eachy和wkai两个大师制作的。我希望在此基础上可以刷线宽，如何实现？ 这把刷子太厉害了！！！ 自贡黄明儒 发表于 2013-7-6 11:54 static/image/common/back.gif
这把刷子太厉害了！！！
多谢提醒，改好之后加载后无法出现对话框了呢？ 自贡黄明儒 发表于 2013-7-6 11:54 static/image/common/back.gif
这把刷子太厉害了！！！
能麻烦帮改改吗，谢谢？ 注册 发表于 2013-7-6 14:47 static/image/common/back.gif
能麻烦帮改改吗，谢谢？
不用了，谢谢，我发现里面有个可以刷宽度的，汗，英文差
页:
[1]