如何获取线段的线型

daiyc88

我想编一个删中心线的lisp,但不知如何获取线段的线型，请教各位大吓

chenknight

（ssget '((6 . "CENTER"))),可以得到中心线的选择集

ZZXXQQ

chenknight发表于2005-10-21 22:45:00 （ssget '((6 . \"CENTER\"))),可以得到中心线的选择集

但中心线的线型如果随图层，这样的程序就不能得到中心线的选择集。

xyp1964

2. (defun c:test (/ la co ln ss)
3.   (if (setq ss (ssget "X"
4.         '((0 . "CIRCLE,ELLIPSE,*LINE,ARC") (6 . "CENTER"))
5.         )
6.       )
7.     (command "erase" ss "")
8.   )
9.   (setq la (tblnext "layer" t))
10.   (while la
11.     (setq lt (CDR (assoc 6 la))
12.    LN (CDR (assoc 2 la))
13.     )
14.     (if (= lt "CENTER")
15.       (if (setq ss
16.    (ssget "X"
17.    (list '(0 . "CIRCLE,ELLIPSE,*LINE,ARC") (cons 8 LN))
18.    )
19.    )
20. (command "erase" ss "")
21.       )
22.     )
23.     (setq la (tblnext "layer" nil))
24.   )
25. )

(defun c:test (/ la co ln ss)   (if (setq ss (ssget "X"         '((0 . "CIRCLE,ELLIPSE,*LINE,ARC") (6 . "CENTER"))         )       )     (command "erase" ss "")   )   (setq la (tblnext "layer" t))   (while la     (setq lt (CDR (assoc 6 la))    LN (CDR (assoc 2 la))     )     (if (= lt "CENTER")       (if (setq ss    (ssget "X"    (list '(0 . "CIRCLE,ELLIPSE,*LINE,ARC") (cons 8 LN))    )    ) (command "erase" ss "")       )     )     (setq la (tblnext "layer" nil))   ) )

无痕

危险哦! 线型为 "center" 的图层里面也可能有其它线型的实体

daiyc88

(defun c:ec (/ la lt ln n ss s1 s2 s3 )
  (setq ss (ssget))
  (if (setq s1 (ssget "p"
        '((0 . "CIRCLE,ELLIPSE,*LINE,ARC") (6 . "CENTER"))
        ))
       (command "erase" s1 ""))
      (setq s3 (ssadd)) 
  (setq la (tblnext "layer" t))
  (while la
    (setq lt (CDR (assoc 6 la))
          LN (CDR (assoc 2 la))
   s2 (ssadd)
   n 0
      )
    (if (= lt "CENTER")
      (setq s2(ssget "x" (list '(0 . "CIRCLE,ELLIPSE,*LINE,ARC") (cons 8 LN)))))    

    (if (/= s2 nil)
      (progn
 (repeat (sslength s2)
   (if (setq ent1(ssmemb (ssname s2 n) ss))
     (progn
       (ssadd ent1 s3)
       (setq n (+ n 1)))
     )))
     )   
    (setq la (tblnext "layer" nil))
    (command "erase" s3 "")
         )
  (prin1)
)

 另外能不能再加一个error语句以防空选，先谢谢版主了

xyp1964

3. (defun c:ec (/ la lt ln n ss s1 s2 s3)
4.   (if (and (setq ss (ssget))
5.     (setq
6.       s1 (ssget "p"
7.          '((0 . "CIRCLE,ELLIPSE,*LINE,ARC") (6 . "CENTER"))
8.   )
9.     )
10.       )
11.     (command "erase" s1 "")
12.   )
13.   (setq s3 (ssadd))
14.   (setq la (tblnext "layer" t))
15.   (while la
16.     (setq lt (CDR (assoc 6 la))
17.    LN (CDR (assoc 2 la))
18.    s2 (ssadd)
19.    n  0
20.     )
21.     (if (= lt "CENTER")
22.       (if (setq s2
23.    (ssget "x"
24.    (list '(0 . "CIRCLE,ELLIPSE,*LINE,ARC") (cons 8 LN))
25.    )
26.    )
27. (progn
28.    (repeat (sslength s2)
29.      (if (setq ent1 (ssmemb (ssname s2 n) ss))
30.        (progn
31.   (ssadd ent1 s3)
32.   (setq n (+ n 1))
33.        )
34.      )
35.    )
36. )
37.       )
38.     )
39.     (setq la (tblnext "layer" nil))
40.     (command "erase" s3 "")
41.   )
42.   (prin1)
43. )

(defun c:ec (/ la lt ln n ss s1 s2 s3)   (if (and (setq ss (ssget))     (setq       s1 (ssget "p"          '((0 . "CIRCLE,ELLIPSE,*LINE,ARC") (6 . "CENTER"))   )     )       )     (command "erase" s1 "")   )   (setq s3 (ssadd))   (setq la (tblnext "layer" t))   (while la     (setq lt (CDR (assoc 6 la))    LN (CDR (assoc 2 la))    s2 (ssadd)    n  0     )     (if (= lt "CENTER")       (if (setq s2    (ssget "x"    (list '(0 . "CIRCLE,ELLIPSE,*LINE,ARC") (cons 8 LN))    )    ) (progn    (repeat (sslength s2)      (if (setq ent1 (ssmemb (ssname s2 n) ss))        (progn   (ssadd ent1 s3)   (setq n (+ n 1))        )      )    ) )       )     )     (setq la (tblnext "layer" nil))     (command "erase" s3 "")   )   (prin1) )

daiyc88

无痕说的对，这样会把CENTER层中的其他线形的图元删掉，还有没有其他更好的方法？

ZZXXQQ

3. (defun c:ec (/ la lt ln n EN1 s1 s2 s3 )
4. (if (setq s1 (ssget "X" '((0 . "CIRCLE,ELLIPSE,*LINE,ARC") (6 . "CENTER"))))
5.   (command "erase" s1 "")
6. )
7. (setq la (tblnext "layer" t))
8. (while la
9.   (setq lt (CDR (assoc 6 la))
10.         LN (CDR (assoc 2 la)) n 0 s3 (ssadd))
11.   (if (= lt "CENTER") (PROGN
12.    (setq s2 (ssget "x" (list '(0 . "CIRCLE,ELLIPSE,*LINE,ARC") (cons 8 LN))))     
13.    (if (/= s2 nil) (progn
14.     (repeat (sslength s2)
15.      (SETQ EN1 (SSNAME S2 N))
16.      (if (NOT (ASSOC 6 (ENTGET EN1))) (SSADD EN1 S3))
17.      (setq n (1+ n)))
18.     )
19.     (command "erase" s3 "")
20.    ))
21.   ))   
22.   (setq la (tblnext "layer" nil))
23. )
24. (princ)
25. )

(defun c:ec (/ la lt ln n EN1 s1 s2 s3 ) (if (setq s1 (ssget "X" '((0 . "CIRCLE,ELLIPSE,*LINE,ARC") (6 . "CENTER"))))   (command "erase" s1 "") ) (setq la (tblnext "layer" t)) (while la   (setq lt (CDR (assoc 6 la))         LN (CDR (assoc 2 la)) n 0 s3 (ssadd))   (if (= lt "CENTER") (PROGN    (setq s2 (ssget "x" (list '(0 . "CIRCLE,ELLIPSE,*LINE,ARC") (cons 8 LN))))         (if (/= s2 nil) (progn     (repeat (sslength s2)      (SETQ EN1 (SSNAME S2 N))      (if (NOT (ASSOC 6 (ENTGET EN1))) (SSADD EN1 S3))      (setq n (1+ n)))     )     (command "erase" s3 "")    ))   ))      (setq la (tblnext "layer" nil)) ) (princ) )

userzhl

好东西！