按色选择与动态线型比例的完美结合，（作者zhynt大师）

simon8001

我说楼主呀，明经的热情人士很多呀，你的问题不但解决了也完美了！

669423907

回复 simon8001 的帖子

也谢谢你的关注啊！

sunchengbo2007

我也试试，谢谢！

susanlingb

好东西，看看

pb.v@163.com

回复 zhynt 的帖子

;;更改线型为虚线
(defun c:GL2()
          (setq a(ssget))
(command"change"a"" "p" "lt" "hidden"""))

你好，大哥，这个是更改为虚线的，但是有时候改出来比例不理想，又要调整比例，现在能不能和动态调整的程式结合，改虚线后马接着调整比例，谢谢。

动态修改线型比例（zhynt）2011-6-23 02:07
(defun c:sf(/ ss alts pt gr s1 lt newscale)
;(prompt "\n请选择非Contiiuous线型: ")
(setq ss (ssget) alts (getvar "LTSCALE") pt (getpoint "\n请指定一个点: "))
(while (= (car (setq gr (grread nil 5 0))) 5)
(redraw)(grdraw (cadr gr) pt 1 1)(setq i -1)
(while (setq s1 (ssname ss (setq i (1  i))))
(if (setq lt (cdr (assoc 6 (entget s1))))(progn
(setq zq (cdr (assoc 40 (tblsearch "ltype" lt))))
(if (/= zq 0)
(setq newscale (/ (distance (cadr gr) pt) zq alts 1.))
(setq newscale 1)))
(progn (setq zq (cdr (assoc 40 (tblsearch "ltype"
(cdr (assoc 6
(tblsearch "layer" (cdr (assoc 8 (entget s1))))))))))
(if (/= zq 0)(setq newscale (/ (distance (cadr gr) pt) zq alts 1.))
(setq newscale 1))))
(vla-put-LinetypeScale (vlax-ename->vla-object s1) newscale)))
(redraw)(princ))

EMD

这个也挺好。学习了。

zyhandw

神人制作！

crazylsp

问一下为什么线型是位于层表中？
楼主的程序有一句子(tblsearch "ltype" (cdr (assoc 6 (tblsearch "layer" (cdr (assoc 8 (entget s1))))）））

zhynt

回复 crazylsp 的帖子

对于线型是随层的图元，不能直接提取到线型，这时就要通过图元所在的图层来提取线型，故此有上述语句。

zhynt

回复 pb.v@163.com 的帖子

2. 
   
3. (defun c:GL2 ()
   
4.   (setq ss (ssget))
   
5.   (command "change" ss "" "p" "lt" "hidden" "")
   
6.   (setq pt (getpoint "\n请为调整比例指定一个点:[不调整] "))
   
7.   (if (/= pt nil)
   
8.     (sf pt ss)
   
9.   )
   
10. )
    
11. (defun sf (pt ss / alts gr s1 lt newscale)
    
12.   (vl-load-com)
    
13.   (setq alts (getvar "LTSCALE"))
    
14.   (while (= (car (setq gr (grread nil 5 0))) 5)
    
15.     (redraw)
    
16.     (grdraw (cadr gr) pt 1 1)
    
17.     (setq i -1)
    
18.     (while (setq s1 (ssname ss (setq i (1+ i))))
    
19.       (setq lt (cdr (assoc 6 (entget s1))))
    
20.       (setq zq (cdr (assoc 40 (tblsearch "ltype" lt))))
    
21.       (if (/= zq 0)
    
22.         (setq newscale (/ (distance (cadr gr) pt) zq alts 1.0))
    
23.         (setq newscale 1)
    
24.       )
    
25.       (vla-put-LinetypeScale (vlax-ename->vla-object s1) newscale)
    
26.     )
    
27.   )
    
28.   (redraw)
    
29.   (princ)
    
30. )
    

<br /> (defun c:GL2 ()<br />   (setq ss (ssget))<br />   (command "change" ss "" "p" "lt" "hidden" "")<br />   (setq pt (getpoint "\n请为调整比例指定一个点:[不调整] "))<br />   (if (/= pt nil)<br />     (sf pt ss)<br />   )<br /> )<br /> (defun sf (pt ss / alts gr s1 lt newscale)<br />   (vl-load-com)<br />   (setq alts (getvar "LTSCALE"))<br />   (while (= (car (setq gr (grread nil 5 0))) 5)<br />     (redraw)<br />     (grdraw (cadr gr) pt 1 1)<br />     (setq i -1)<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq lt (cdr (assoc 6 (entget s1))))<br />       (setq zq (cdr (assoc 40 (tblsearch "ltype" lt))))<br />       (if (/= zq 0)<br />         (setq newscale (/ (distance (cadr gr) pt) zq alts 1.0))<br />         (setq newscale 1)<br />       )<br />       (vla-put-LinetypeScale (vlax-ename->vla-object s1) newscale)<br />     )<br />   )<br />   (redraw)<br />   (princ)<br /> )<br />