langjs 发表于 2009-4-6 13:55:00

[转帖]一个指定图层批量修改线宽的程序

<p>;&nbsp;&nbsp; =======================================<br/>;&nbsp;&nbsp; |&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Ver: 1.1&nbsp;&nbsp; 作者: 聂金锁&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; |<br/>;&nbsp;&nbsp; |&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 修改: 迟俊岭&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; |<br/>;&nbsp;&nbsp; =======================================</p><p>;;;指定图层修改线宽，命令“XK”。</p><p>(defun *error*(st)<br/>&nbsp; (if (and (/= st "Function cancelled")<br/>&nbsp;&nbsp;&nbsp; (/= st "quit / exit abort")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (princ (strcat "Error: " st))<br/>&nbsp; )<br/>&nbsp; (setq *error* old_err)<br/>&nbsp; (princ)<br/>)</p><p>(defun in()</p><p>&nbsp; (if (= s nil) (setq s 1))<br/>&nbsp; (setq scale (getreal (strcat "\n指定线型比例&lt;" (rtos s 2 0) "&gt;:")))<br/>&nbsp; (if (= scale nil) (setq scale s))<br/>&nbsp; (setq s scale)</p><p>&nbsp; (if (= w nil) (setq w 0.6))<br/>&nbsp; (setq width (getreal (strcat "\n指定线宽 &lt;" (rtos w 2 2) "&gt;:")))<br/>&nbsp; (if (= width nil) (setq width w))<br/>&nbsp; (setq w width)</p><p>&nbsp; (setq width (* width scale))<br/>)</p><p>(defun pross()<br/>&nbsp;(setq len (sslength ss))<br/>&nbsp;(setq n 1)<br/>&nbsp; (while (&lt;= n len)<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq en1 (ssname ss (1- n)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq b (entget en1))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq a (cdr (assoc 0 b)))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (cond ((or (= "LINE" a) (= "ARC" a))<br/>&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (command "pedit" en1 "Y" "w" width "x")<br/>&nbsp;&nbsp;&nbsp; ))<br/>&nbsp;&nbsp;&nbsp; ((= "POLYLINE" a)<br/>&nbsp;&nbsp;&nbsp;&nbsp; (command "pedit" en1 "w" width "x"))<br/>&nbsp;&nbsp;&nbsp; ((= "CIRCLE" a)<br/>&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq pt (cdr (assoc 10 b)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq rad (cdr (assoc 40 b)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq r1 (- (* rad 2)&nbsp; width ))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq r2 (+ (* rad 2)&nbsp; width ))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (command "donut" r1 r2 pt "")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (entdel en1)<br/>&nbsp;&nbsp;&nbsp;&nbsp; ))</p><p>&nbsp;&nbsp;&nbsp; (T T)<br/>&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq n (1+ n))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>)</p><p>(defun C:xk ( / old_err scale ss en1 a len n b<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cmd_old width rad pt r1 r2 k en la)<br/>&nbsp;&nbsp;&nbsp; (setq old_err *error*)<br/>&nbsp;&nbsp;&nbsp; (setq cmd_old (getvar "cmdecho"))<br/>&nbsp;&nbsp;&nbsp; (setvar "cmdecho" 0)<br/>&nbsp;&nbsp;&nbsp; (in)<br/>&nbsp;&nbsp;&nbsp; (initget "L S")<br/>&nbsp;&nbsp;&nbsp; (setq k (getkword "\选择对象，或者[图层(L)]: "))<br/>&nbsp;&nbsp;&nbsp; (if (= k "L")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq en (car (entsel "\n选择图层上的对象: ")))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (/= en nil)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq la (assoc 8 (entget en)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq ss (ssget "X" (list la)))</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (pross)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )</p><p>&nbsp;&nbsp;&nbsp; (if (or (= k "S")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (= k nil))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq ss (ssadd))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq ss (ssget))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (/= ss nil) (pross))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )</p><p>&nbsp;&nbsp;&nbsp; (setvar "cmdecho" cmd_old)<br/>&nbsp;&nbsp;&nbsp; (princ)<br/>)<br/></p>

578749467 发表于 2010-11-27 17:47:00

谢谢分享

chpmould 发表于 2010-11-28 14:05:22

帮LZ顶一下...

daiguafan 发表于 2010-11-28 15:03:31

不错，不错

461045462 发表于 2010-11-28 17:34:37

谢谢楼主的分享
收藏了，学习学习

zsw23 发表于 2010-11-29 09:55:49

谢谢分享，顶！

display18 发表于 2011-1-7 13:19:28

谢谢楼主分享

shalei021647 发表于 2011-11-15 05:04:01

怎么出现图层名称无效？

zhengchuan 发表于 2012-9-13 01:31:40

不错，不错
页: [1]
查看完整版本: [转帖]一个指定图层批量修改线宽的程序