社区 › AutoLISP/Visual LISP 编程技术 › 按色选择与动态线型比例的完美结合，（作者zhynt大师）

simon8001 发表于 2011-7-6 08:32:44

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

669423907 发表于 2011-7-6 08:49:11

回复 simon8001 的帖子

也谢谢你的关注啊！

sunchengbo2007 发表于 2011-7-8 08:44:48

我也试试，谢谢！

susanlingb 发表于 2011-7-8 10:01:42

好东西，看看

pb.v@163.com 发表于 2011-7-22 09:05:43

回复 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 (1i))))
(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 发表于 2011-7-22 09:16:01

这个也挺好。学习了。

zyhandw 发表于 2011-7-22 09:25:26

神人制作！

crazylsp 发表于 2011-7-22 09:42:34

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

zhynt 发表于 2011-7-22 10:44:53

回复 crazylsp 的帖子

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

zhynt 发表于 2011-7-22 11:27:54

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


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

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