自动调整线型比例 【有源码】
声明：这段源码来自明经，最初的作者已无从考证，应该是个台湾同胞吧，若见此帖，先谢过！作图时，经常会使用到很多不同长度的非连续线，比如center hidden。而LTS线型比例是固定的，因为长短的不同，照顾不了所有的线段都能如实显示（很多短线因此显示为连续线）
问题来了，如何实现框选所有需要改变线型比例的线段，使之根据自身长短，自动调整到合适的比例呢？
下面便是本文字首的源码：目前只能实现所有线段变为合适比例的hidden线，不能同时针对多线型。且目前看来，自动调整的效果还待完善。开此贴，看需要的人多不多，若多，希望高手改善之，希望在将来，此帖还能帮助更多的人。
(defun c:df () ;自動變換成適當比例的虛線
(ltchange "dashed"3 "bylayer")
(princ)
)
(defun ltchange (type1 scale color /oce lin n namtab
pt1 pt2 x1 x2y1 y2 len legsca
otypocoloscacoltyp lts rad
) ;自動變換成適當比例的中心線
(setq oce (getvar "cmdecho")
lts (getvar "ltscale")
) ;_ end of setq
(setvar "cmdecho" 0)
(setq n 0)
(strcat "Select object change to " type1 ":")
) ;_ end of print
(setq lin (ssget '((-4 . "<OR")
(0 . "LINE")
(0 . "CIRCLE")
(0 . "ELLIPSE")
(0 . "ARC")
(0 . "polyline")
(-4 . "OR>")
)
) ;_ end of ssget
) ;end setq
(if (not lin)
(progn
(alert "\nNo selection!")
(exit)
) ;_ end of progn
) ;end if
(repeat (sslength lin)
(setq nam (ssname lin n))
(setq tab (entget nam))
;;;;;;;;;;circle
(if (= (cdr (assoc 0 tab)) "CIRCLE")
(progn
(setq rad (cdr (assoc 40 tab)))
(setq len (* 2 (* 3.14 rad)))
) ;如是圓實體取周長為"len"
;;;;;;;;;;ARC
(if (= (cdr (assoc 0 tab)) "ARC")
(progn
(setq rad (cdr (assoc 40 tab)))
(setq len (* 3.14 rad))
) ;end progn;如是圓弧取其圓周長半
;;;;;;;;;;ellipse
(if (= (cdr (assoc 0 tab)) "ellipse")
(progn
(setq rad (cdr (assoc 40 tab)))
(setq len (* 2 (* 3.14 rad)))
)
;;;;;;;;;LINE
(progn
(setq pt1 (cdr (assoc 10 tab))
pt2 (cdr (assoc 11 tab))
len (distance pt1 pt2)
) ;end setq
) ;end progn
) ;end if
)
);end if
(cond ((and (> len 0) (<= len 2))
(setq leg 2)
)
((and (> len 2) (<= len 5))
(setq leg 6)
)
((and (> len 5) (<= len 30))
(setq leg 20)
)
((and (> len 30) (<= len 50))
(setq leg 40)
)
((and (> len 50) (<= len 100))
(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
;_ end of command
;_ end of command
(setq n (+ n 1))
) ;end repeat
(setvar "cmdecho" oce)
(princ)
) ;_ end of defun
(defun c:df () ;自動變換成適當比例的虛線
(ltchange "dashed"3 "bylayer")
(princ)
)
(defun c:df () ;自動變換成適當比例的中心線
(ltchange "center2"3 "bylayer")
(princ)
)
ZZXXQQ 发表于 2014-11-26 21:49 static/image/common/back.gif
(defun c:df () ;自動變換成適當比例的虛線
(ltchange "dashed"3 "bylayer")
(princ)
感谢Z版！
根据Z版的提示，我更新一下首段 改为如下语句：
(defun c:dfd () ;自動變換成適當比例的虛線
(ltchange "dashed"3 "bylayer")
(princ)
)
(defun c:dfc () ;自動變換成適當比例的中心線
(ltchange "center2"3 "bylayer")
(princ)
)
********后面的语句不变*******
这样输入DFD改变dash线线型，输入DFC改变center线的比例。虽然目前还不能一次调整多种线型，多种图层。但是把这两个命令分开，针对性的调整也可以。一般来说，我们的习惯都是把不同线型的分不同的图层，这样按图层操作起来也不是很麻烦。谢谢！http://v1.freep.cn/3tb_14112721044592tb512293.gif 很赞.感谢Z版 ,感谢楼主, 图层我觉得还是次要的.主要是PL线不支持~ 将
(setq lin (ssget '((-4 . "<OR")
(0 . "LINE")
(0 . "CIRCLE")
(0 . "ELLIPSE")
(0 . "ARC")
(0 . "polyline")
(-4 . "OR>")
)
) ;_ end of ssget
) ;end setq
改成
(setq lin (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))) ZZXXQQ 发表于 2014-11-28 07:48 static/image/common/back.gif
将
(setq lin (ssget '((-4 . "")
)
改了错误框是没跳出来了,但是还是没改成虚线或点划线. 同问 bai2000 发表于 2014-11-29 00:19 static/image/common/back.gif
同问
实在不行，分别用DFDDFC控制虚线和点划线 lengxiaxi 发表于 2014-11-29 11:56 static/image/common/back.gif
实在不行，分别用DFDDFC控制虚线和点划线
(defun c:df () ;自動變換成適當比例的虛線
(setq lts (getvar "ltscale"))
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 0)
(repeat (sslength SS)
(setq CURVE (vlax-ename->vla-object (SETQ ENT (ssname SS N))))
(setq LENG (vlax-curve-getdistatparamCURVE (vlax-curve-getendparam CURVE) ) )
( IF (SETQ F (ASSOC 6 (ENTGET ENT)))
(SETQ Q (CDR F) ) (SETQ Q "continous"))
(ltchange ENT (/ LENG lts))
(setq N (1+ N))
)
)
(defun ltchange (ENT LEN /oce lin n namtab
pt1 pt2 x1 x2y1 y2 legsca
otypocoloscacoltyp lts rad
)
(cond ((and (> len 0) (<= len 2))
(setq leg 2)
)
((and (> len 2) (<= len 5))
(setq leg 6)
)
((and (> len 5) (<= len 30))
(setq leg 20)
)
((and (> len 30) (<= len 50))
(setq leg 40)
)
((and (> len 50) (<= len 100))
(setq leg 75)
)
((> len 100)
(setq leg 100)
)
) ;end cond
(setq sca (/ leg 15))
(command "change" ENT "" "p" "s" SCA "") ;_ end of command
(setq n (+ n 1))
)
自动识别线型，没有测试 本帖最后由 暗夜贵族 于 2015-7-14 10:16 编辑
lengxiaxi 发表于 2014-11-29 11:56 static/image/common/back.gif
实在不行，分别用DFDDFC控制虚线和点划线
重新修改了一下
[*](defun c:df () ;自動變換成適當比例的虛線
[*](setq lts (getvar "ltscale"))
[*](vl-load-com)
[*](setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
[*](setq ss_count 0 ss_total (sslength ss))
[*](WHILE (< ss_count ss_total )
[*] (setq ent (ssname ss ss_count))
[*] (setq ss_count (+ 1 ss_count) )
[*] (setq CURVE (vlax-ename->vla-object ent))
[*] (setq LENG (vlax-curve-getdistatparamCURVE (vlax-curve-getendparam CURVE) ) )
[*] ( IF (SETQ F (ASSOC 6 (ENTGET ENT)))
[*] (SETQ Q (CDR F) ) (SETQ Q "continous"))
[*] (ltchange ENT (/ LENG lts) Q)
[*])
[*])
[*](defun ltchange (ENT LENLTP/oce lin n namtab
[*] pt1 pt2 x1 x2y1 y2 legsca
[*] otypocoloscacoltyp lts rad
[*])
[*](cond
[*] ((= LTP "ACAD_ISO02W100")(SETQ LTPL 15))
[*] ((= LTP "ACAD_ISO03W100")(SETQ LTPL 30))
[*] ((= LTP "ACAD_ISO04W100")(SETQ LTPL 30))
[*] ((= LTP "ACAD_ISO05W100")(SETQ LTPL 33))
[*] ((= LTP "ACAD_ISO06W100")(SETQ LTPL 36))
[*] ((= LTP "ACAD_ISO07W100")(SETQ LTPL 3))
[*] ((= LTP "ACAD_ISO08W100")(SETQ LTPL 36))
[*] ((= LTP "ACAD_ISO09W100")(SETQ LTPL 45))
[*] ((= LTP "ACAD_ISO10W100")(SETQ LTPL 18))
[*] ((= LTP "ACAD_ISO11W100")(SETQ LTPL 33))
[*] ((= LTP "ACAD_ISO12W100")(SETQ LTPL 21))
[*] ((= LTP "ACAD_ISO13W100")(SETQ LTPL 36))
[*] ((= LTP "ACAD_ISO14W100")(SETQ LTPL 24))
[*] ((= LTP "ACAD_ISO15W100")(SETQ LTPL 39))
[*])
[*](cond
[*] ((< LEN 15)(SETQ sca (/ LEN LTPL 2.5)))
[*] ((< LEN 30)(SETQ sca (/ LEN LTPL 3.5)))
[*] ((>= LEN 30)(SETQ sca 1))
[*])
[*](command "change" ENT "" "p" "s" SCA "")
[*])
页:
[1]