请问如何判断选择集是否存在非Continuous线型呢？
请问如何判断选择集是否存在非Continuous线型呢？(setq ss00 (ssget":s"))
(if (and (/= ss00 nil)(存在非Continuous线型))
(progn
,,,,,,,,,,,,,,,,,,,,,,,
谢谢了 (if (ssget "p"'((-4 . "<not")(6 . "Continuous") (-4 . "not>"))) "存在非Continuous线型" "没有") Gu_xl 发表于 2014-10-24 21:49 static/image/common/back.gif
(if (ssget "p"'((-4 . ""))) "存在非Continuous线型" "没有")
非常感谢G版帮助 Gu_xl 发表于 2014-10-24 21:49 static/image/common/back.gif
(if (ssget "p"'((-4 . ""))) "存在非Continuous线型" "没有")
(defun c:ad()
(setq ss00 (ssget":s"))
(if (/= ss00 nil)
(progn
(setq pt (getpoint "\n左键虚线，右键中心线"))
(if pt (ad2)(ad1)))))
;请问G版，要怎么加进去呢？我想在ss00不存在 存在非Continuous线型 （所有线型都是随层的）时就中断
(defun c:ad()
(setq ss00 (ssget":s"))
(if (/= ss00 nil)
(progn
(setq pt (getpoint "\n左键虚线，右键中心线"))
(if pt (ad2)(ad1)))))
(defun ad1()
(command "Select" ss00 "")
(setq ss (ssget "p" '((8 . "~1虚线"))))
(if (/= ss nil)(progn
(sssetfirst nil ss)(ad?)))
(while (> (getvar "cmdactive") 0)(command pause))
(command "Select" ss00 "")
(setq ss (ssget "p" '((8 . "1虚线"))))
(if (/= ss nil)(progn
(sssetfirst nil ss)(ad?))))
(defun ad2()
(command "Select" ss00 "")
(setq ss (ssget "p" '((8 . "~2中心线"))))
(if (/= ss nil)(progn
(sssetfirst nil ss)(ad?)))
(while (> (getvar "cmdactive") 0)(command pause))
(command "Select" ss00 "")
(setq ss (ssget "p" '((8 . "2中心线"))))
(if (/= ss nil)(progn
(sssetfirst nil ss)(ad?))))
;动态修改线型比例 zhynt 于 2011-6-23 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=87832
(defun ad?(/ ss alts pt gr s1 lt newscale)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq gbwz (grread 3));光标位置
(if (member (car gbwz) '(3 5))
(progn (setq sbd (cadr gbwz))));鼠标位置
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(prompt "\n 请选择物体:")
(setq ss(ssget":s"))
(if ss
(progn
(setq alts (getvar "LTSCALE"))
;(setq pt (getpoint "\n请选择一个点: "))
(setq pt sbd)
(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))
;因随层的线型没有组码6，所以原程序将其跳过去了。现在我新加了判断，当随层时，找其所在的图层，通过图层来确定线型。
;因实线的组码40的值为0，程序将出错（除数为零）所以再加以判断如果为0，将newscale的值置为1 本帖最后由 llsheng_73 于 2014-10-25 17:05 编辑
(if(ssget"p"'((6 . "~Continuous")))t)
但是有个问题，如果图层线型或者图块线型是Continuous,而图元线型是随层或者随块的话，也会被排除掉 669423907 发表于 2014-10-24 23:04 static/image/common/back.gif
(defun c:ad()
(setq ss00 (ssget":s"))
(if (/= ss00 nil)
(defun c:ad()
(if(setq ss00(ssget":s"'((6 . "~Continuous"))))
(if(getpoint "\n左键虚线，右键中心线")(ad2)(ad1))))别的没看懂只把这个地方给你改了一下，不必要的变量没必要出现 llsheng_73 发表于 2014-10-25 17:11 static/image/common/back.gif
别的没看懂只把这个地方给你改了一下，不必要的变量没必要出现
谢谢 llsheng_73 大师，的确如您所说的，图元随层，要判断图元所在层的线型，，，，，，，，，
程序是我东拼西凑出来的，程序的功能是：
选择一堆东西：
A：如果 ss00 里有 虚线 和 中心线时：
1：点左键就先修改虚线的线型比例，修改完后就修改中心线的线型比例，
2：点右键，与1的顺序相反
B：如果虚线 和 中心线 不同时存在 ss00 里时（可以有其它线型），无点右键或左键都会对 ss00 里的非 Continuous 线型的对象进行线型比例修改，然后结束
A 种情况会修改两次，
B 种情况只修改一次
选择的情况是：如果 ss00 里全是Continuous线型的东西或根本没有可以修改的东西时，程序还会点左键或右键，，，，，，，，，，
页:
[1]