[转贴]：AutoCAD工具--改变线宽

manfred_sun

AutoCAD工具--改变线宽  


工程设计制图中，经常遇到线或园需要加粗的情况。利用AutoCAD自身的绘图编辑命令是较难实现的，结合AutoCAD强有力的二次开发工具--AutoLISP，就可以轻松解决这个问题。

　　编程思路为：取出线或园等实体的图形信息（起点、终点、园心等等），用PLINE命令以定义的宽度重新绘出这个实体。例如：改变LINE、PLINE的宽度可以直接用PEDIT命令；改变TRACE的宽度，可以先求出TRACE的起点与终点，然后删除它，再用PLINE在起点与终点之间重新绘出改变后宽度的多义线；改变CIRCLE的宽度可以先求出半径及园心；改变ARC的宽度则必须求出弧的起点、终点、园心、半径。好了，具体还是请您亲自试一试吧！

　　使用方法：将CHGWIDTH.LSP文件置于绘图工作目录下，在COMMAND:提示符下输入命令（LOAD “CHGWIDTH”），再键入CHGWIDTH就可以使用这个工具。

　　附：CHGWIDTH.LSP程序清单

(defun _myerr (s) (if (/= s "Function cancelled") (princ (strcat "\nError: " s))
) (setvar "luprec" wj) (setq *error* olderr) (setvar "cmdecho" 1) (princ) ) (defun
c:chgwidth (/ a ss1 n s1 ss2 ty wj width p10 p11 p20 p1 p2 mang thick) (if (null
sck) (alert " 请先运行 \" 初 始 化 \" 菜单! ") (progn (setq wj (getvar "luprec") olderr
*error* *error* _myerr a 1) (setvar "cmdecho" 0) (setvar "luprec" 2) (setq width
(getreal "\n 请输入新线宽<回车为0.5>:")) (if (null width) (setq width (* 0.5 sck)) (setq
width (* width sck)) ) (princ (strcat " 当前线宽为" (rtos width 2 1) ".")) (while (<=
a 1000) (setq ss1 (ssget)) (if (null ss1) (setq a 1000) (progn (setq n (sslength
ss1)) (setq s1 0) (while (< s1 n) (setq ss2 (ssname ss1 s1)) (setq ty (cdr (assoc
0 (entget ss2)))) (cond ((= ty "POLYLINE") (command "_pedit" ss2 "_w" width "")
) ((= ty "LINE") (command "_pedit" ss2 "_y" "_w" width "") ) ((= ty "TRACE") (progn
(setq p10 (cdr (assoc 10 (entget ss2)))) (setq p11 (cdr (assoc 11 (entget ss2))))
(setq p20 (cdr (assoc 12 (entget ss2)))) (setq p21 (cdr (assoc 13 (entget ss2))))
(setq thick (distance p10 p11)) (setq mang (angle p10 p11)) (setq p1 (polar p10
mang (/ thick 2))) (setq p2 (polar p20 mang (/ thick 2))) (command "_erase" ss2
"") (command "_pline" p1 "_w" width width p2 "") ) ) ((= ty "CIRCLE") (progn (setq
p11 (cdr (assoc 10 (entget ss2)))) (setq p21 (cdr (assoc 40 (entget ss2)))) (setq
p10 (- (* p21 2) width)) (setq p20 (+ (* p21 2) width)) (command "_erase" ss2
"") (command "_donut" p10 p20 p11 "") ) ) ((= ty "ARC") (progn (setq p10 (cdr
(assoc 10 (entget ss2)))) (setq p20 (cdr (assoc 40 (entget ss2)))) (setq p11 (cdr
(assoc 50 (entget ss2)))) (setq p21 (cdr (assoc 51 (entget ss2)))) (setq p1 (polar
p10 p11 p20)) (setq p2 (polar p10 p21 p20)) (command "_erase" ss2 "") (command
"_pline" p1 "_w" width width "_a" "_ce" p10 p2 "") ) ) ((and (/= ty "PLINE") (/=
ty "LINE") (/= ty "TRACE") (/= ty "CIRCLE") (/= ty "ARC")) (prompt "\n 该实体无法加粗,请继续选择.")
) ) (setq s1 (+ s1 1)) ) ) ) (setq a (+ a 1)) ) (setvar "luprec" wj) (setvar "cmdecho"
1) (setq *error* olderr) ) ) (princ) ) (princ)　



作者：白开心
来源：bbs.17grow.com

舍我其谁

跟cad 里的pe有不同吗？

xiaotang

今天才知道原来pe也可以改普通直线呀，谢谢

麻雀

PE不能改圆

cdcdcd

very thank y

qblong

CAD中不是可以直接改吗？

zxdcad

楼主编的这个Lisp加粗还没有我编的功能多，


我编了一个，可以解决线段、多段线（POLYLINE与LWPOLYLINE）、圆、圆弧、椭圆、样条曲线的加粗或改变宽度的问题，

但至今无法解决椭圆弧加粗，因为将PELLIPSE变量设为0，画出的椭圆弧是真正椭圆弧，无法加粗，PELLIPSE变量设为1，ACAD不能画椭圆弧了。因此没办法了。

不知哪位高人能解决这个问题就好了。