可以自动改变直线，圆等的线形比例
<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> 不错的代码。 怎样自动改变直线，圆等的线形比例？比如说我把图比例放大它也能自动调整线性比例？(defun c:tt (/ scale ss n k obj)
(setq scale (getreal "\n输入线型转换比例"))
(if (not scale) (exit))
(princ"\n选择要转换线型比例的实体：")
(setq ss (ssget))
(if ss
(progn
(setq n (sslength ss)
k 0)
(repeat n
(setq obj (vlax-ename->vla-object (ssname ss k)))
(setq newscale (* scale (vla-get-LinetypeScale obj)))
(vla-put-linetype obj "dashed")
(vla-put-LinetypeScale obj newscale)
(setq k (1+ k))
)
)
)
)
Gu_xl的程序如能自动根据实体的长度来判断比例就好了 xyz2009xyz 发表于 2010-7-26 08:24 static/image/common/back.gif
怎样自动改变直线，圆等的线形比例？比如说我把图比例放大它也能自动调整线性比例？
这个好像不好实现 请帮忙顶起 有没有像燕秀自动线型比例的代码 有没有改标注比例的？可以根据所框选的范围，设定标注的与框选范围的比例? 能达到自动设置比例，适合让肉眼看到的比例吗？ 顶起来，好像SMARTOOLS中有个自动线型比例挺好用的的，他是按屏幕的尺寸确定比例的，可惜没源码
页:
[1]
2