可以自动改变直线圆等的线形比例 ,但不能改变矩形及多段线的 请修改一下
<p>大家好 我这有一个非常好的LISP程序 可以自动改变直线，圆等的线形比例 但不能改变矩形及多段线的的 哪位大大修改一下</p><p> </p><p>(defun c:df () ;自動變換成適當比例的虛線<br/> (ltchange "dashed" 3 "bylayer")<br/> (princ)<br/>)</p><p>(defun ltchange (type1 scale color / oce lin n nam tab<br/> pt1 pt2 x1 x2 y1 y2 len leg sca<br/> otyp ocol osca col typ lts rad<br/> ) ;自動變換成適當比例的中心線<br/> (setq oce (getvar "cmdecho")<br/> lts (getvar "ltscale")<br/> ) ;_ end of setq<br/> (setvar "cmdecho" 0)<br/> (setq n 0)<br/> (print<br/> (strcat "Select object change to " type1 ":")<br/> ) ;_ end of print<br/> (setq lin (ssget '((-4 . "<OR")<br/> (0 . "LINE")<br/> (0 . "CIRCLE")<br/> (0 . "ELLIPSE")<br/> (0 . "ARC")<br/> (0 . "polyline")<br/> (-4 . "OR>")<br/> )<br/> ) ;_ end of ssget<br/> ) ;end setq<br/> (if (not lin)<br/> (progn</p><p> (alert "\nNo selection!")<br/> (exit)<br/> ) ;_ end of progn<br/> ) ;end if<br/> (repeat (sslength lin)<br/> (setq nam (ssname lin n))<br/> (setq tab (entget nam))<br/>;;;;;;;;;;circle<br/> (if (= (cdr (assoc 0 tab)) "CIRCLE")<br/> (progn<br/> (setq rad (cdr (assoc 40 tab)))<br/> (setq len (* 2 (* 3.14 rad)))<br/> ) ;如是圓實體取周長為"len"<br/>;;;;;;;;;;ARC<br/> (if (= (cdr (assoc 0 tab)) "ARC")<br/> (progn<br/> (setq rad (cdr (assoc 40 tab)))<br/> (setq len (* 3.14 rad))<br/> ) ;end progn;如是圓弧取其圓周長半 </p><p>;;;;;;;;;;ellipse<br/> (if (= (cdr (assoc 0 tab)) "ellipse")<br/> (progn<br/> (setq rad (cdr (assoc 40 tab)))<br/> (setq len (* 2 (* 3.14 rad)))<br/> )<br/>;;;;;;;;;LINE<br/> (progn<br/> (setq pt1 (cdr (assoc 10 tab))<br/> pt2 (cdr (assoc 11 tab))<br/> len (distance pt1 pt2)<br/> ) ;end setq<br/> ) ;end progn<br/> ) ;end if <br/> )<br/> );end if</p><p> (cond ((and (> len 0) (<= len 2))<br/> (setq leg 2)<br/> )<br/> ((and (> len 2) (<= len 5))<br/> (setq leg 6)<br/> )<br/> ((and (> len 5) (<= len 30))<br/> (setq leg 20)<br/> )<br/> ((and (> len 30) (<= len 50))<br/> (setq leg 40)<br/> )<br/> ((and (> len 50) (<= len 100))<br/> (setq leg 75)<br/> )<br/> ((> len 100)<br/> (setq leg 100)<br/> )<br/> ) ;end cond<br/> (setq sca (/ leg scale lts 2))</p><p> (command "-linetype" "l" type1 "acad.lin" "" "")<br/> (command "change" nam "" "p" "c" color "lt" type1 "s" SCA "") ;_ end of command<br/> ;_ end of command<br/> ;_ end of command<br/> (setq n (+ n 1))<br/> ) ;end repeat<br/> (setvar "cmdecho" oce)<br/> (princ)<br/>) ;_ end of defun<br/></p> 本帖最后由 作者 于 2010-5-1 20:42:48 编辑(defun c:df () ;自動變換成適當比例的虛線
(ltchange "dashed" 3 "bylayer")
(princ)
)
(defun ltchange (type1 scale color / oce lts lin n nam len leg sca) ;自動變換成適當比例的中心線
(setq oce (getvar "cmdecho")
lts (getvar "ltscale"))
(setvar "cmdecho" 0)
(setq n 0)
(princ (strcat "\nSelect object change to " type1 ":"))
(if (setq lin (ssget '((0 . "ARC,CIRCLE,*LINE,ELLIPSE")))) (progn
(repeat (sslength lin)
(setq nam (ssname lin n))
(command "lengthen" nam "")
(setq LEN (getvar "perimeter"))
(cond
((> 2 len 0) (setq leg 2))
((> 5 len 2) (setq leg 6))
((> 30 len 5) (setq leg 20))
((> 50 len 30) (setq leg 40))
((> 100 len 50) (setq leg 75))
((> len 100) (setq leg 100))
);end cond
(setq sca (/ leg scale lts 2))
(command "-linetype" "l" type1 "acad.lin" "" "")
(command "change" nam "" "p" "c" color "lt" type1 "s" SCA "") ;_ end of command
(setq n (1+ n))
);end repeat
));end if
(setvar "cmdecho" oce)
(princ)
);_ end of defun
谢啦但我试了下说是错误参数太多不能用啊 <p>二楼已改，再试试。</p> 还是不行啊，df \nSelect object change to dashed:; 错误: 参数太多
是不是版本不同啊我是CAD2004的 把矩形及多段线打散也可以的
帮忙再改下 <p>我是在2004下调试通过的，没问题呀！</p> (defun c:df () ;自動變換成適當比例的虛線
(ltchange "dashed" 3 "bylayer")
(princ)
)
(defun ltchange (type1 scale color / oce lts lin n nam len leg sca) ;自動變換成適當比例的中心線
(setq oce (getvar "cmdecho")
lts (getvar "ltscale"))
(setvar "cmdecho" 0)
(setq n 0)
(princ (strcat "\\nSelect object change to " type1 ":"))
(if (setq lin (ssget \'((0 . "ARC,CIRCLE,*LINE,ELLIPSE")))) (progn
(repeat (sslength lin)
(setq nam (ssname lin n))
(command "lengthen" nam "")
(setq LEN (getvar "perimeter"))
(cond
((> 2 len 0) (setq leg 2))
((> 5 len 2) (setq leg 6))
((> 30 len 5) (setq leg 20))
((> 50 len 30) (setq leg 40))
((> 100 len 50) (setq leg 75))
((> len 100) (setq leg 100))
);end cond
(setq sca (/ leg scale lts 2))
(command "-linetype" "l" type1 "acad.lin" "" "")
(command "change" nam "" "p" "c" color "lt" type1 "s" SCA "") ;_ end of command
(setq n (1+ n))
);end repeat
));end if
(setvar "cmdecho" oce)
(princ)
);_ end of defun
是这样吧我怎么试就是不行呢
[此贴子已经被作者于2010-5-1 20:42:48编辑过] 谢啦 我又试了下 可以了ssget \'((0 . "ARC,CIRCLE,*LINE,ELLIPSE"))把里面的\去掉就可以了 还是不行啊，df \nSelect object change to dashed:; 错误: 参数太多<br/>是不是版本不同啊 我是CAD2004的 把矩形及多段线打散也可以的<br/><br/>帮忙再改下 回9楼：看8楼的改动。
页:
[1]