请问如何判断选择集是否存在非Continuous线型呢？

669423907

请问如何判断选择集是否存在非Continuous线型呢？
(setq ss00 (ssget":s"))
(if (and (/= ss00 nil)(存在非Continuous线型))
(progn
,,,,,,,,,,,,,,,,,,,,,,,
谢谢了

Gu_xl

(if (ssget "p"  '((-4 . "<not")(6 . "Continuous") (-4 . "not>"))) "存在非Continuous线型" "没有")

669423907

Gu_xl 发表于 2014-10-24 21:49
(if (ssget "p"  '((-4 . ""))) "存在非Continuous线型" "没有")

非常感谢G版帮助

669423907

Gu_xl 发表于 2014-10-24 21:49
(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

1. (if(ssget"p"'((6 . "~Continuous")))t)

(if(ssget"p"'((6 . "~Continuous")))t)

但是有个问题，如果图层线型或者图块线型是Continuous,而图元线型是随层或者随块的话，也会被排除掉

llsheng_73

669423907 发表于 2014-10-24 23:04
(defun c:ad()
(setq ss00 (ssget":s"))
(if (/= ss00 nil)

2. (defun c:ad()
   
3. (if(setq ss00(ssget":s"'((6 . "~Continuous"))))
   
4.    (if(getpoint "\n左键虚线，右键中心线")(ad2)(ad1))))

(defun c:ad() <br /> (if(setq ss00(ssget":s"'((6 . "~Continuous"))))<br />    (if(getpoint "\n左键虚线，右键中心线")(ad2)(ad1))))

别的没看懂只把这个地方给你改了一下，不必要的变量没必要出现

669423907

llsheng_73 发表于 2014-10-25 17:11
别的没看懂只把这个地方给你改了一下，不必要的变量没必要出现

谢谢 llsheng_73 大师，的确如您所说的，图元随层，要判断图元所在层的线型，，，，，，，，，
程序是我东拼西凑出来的，程序的功能是：

选择一堆东西：
A：如果 ss00 里有 虚线 和 中心线时：

1：点左键就先修改虚线的线型比例，修改完后就修改中心线的线型比例，
2：点右键，与1的顺序相反

B：如果  虚线 和 中心线 不同时存在 ss00 里时（可以有其它线型），无点右键或左键都会对 ss00 里的非 Continuous 线型的对象进行线型比例修改，然后结束

A 种情况会修改两次，
B 种情况只修改一次

选择的情况是：如果 ss00 里全是Continuous线型的东西或根本没有可以修改的东西时，程序还会点左键或右键，，，，，，，，，，