ssget可以这样选择吗：(ssget '((0 . "LINE")(长度 . "100")))

张大锤

请问当我们选择一根线的时候 (setq aa (ssget '((0 . "LINE")))) 要知道他的长度 需要 得到10和11 再用(distance 10 11) 计算得到长度
那么请问的是 是否可以使用setq 只选择 长度为100的线
如：(setq aa (ssget '((0 . "LINE")(长度 . "100"))))
疑问：因为圆是直接可以选择半径的 那么线有直接的长度值吗？ 上边的写法可以实现吗？
这么做是因为 图面都是由线组成的
现在的做法是 判断出100的线 找到中心点画一个圆 使用循环 但是速度会特别的慢
如果选择直接得到100的线 计算中心点会省略很多循环的算法 节约了时间
（100的线只是我举例 不要纠结100的线很常见的问题）



顺便问一个entmake创建的问题
当entmake创建块的时候 如果创建带有属性的数值
使用这个是没有属性那个数值的

1. (defun c:tt( / del_ent ele ent i must new_ent)
   
2.   (setq ent (entget (car (entsel "\n選擇一個圖元"))))       ;得到組碼
   
3.   (setq i 0 must '())                ;初始化
   
4.   (repeat (length ent)
   
5.     (setq del_ent (vl-remove (nth i ent) ent))        ;測試刪除  
   
6.     (setq new_ent (entmake del_ent))                   ;測試生成
   
7.     (if (= 10 (car (nth i ent)))
   
8.       (progn
   
9.         (setq must (append must (list (nth i ent))))
   
10.         (if new_ent
    
11.           (entdel (entlast))
    
12.         )
    
13.       )
    
14.       (if new_ent   
    
15.         (entdel (entlast))  
    
16.         (setq must (append must (list (nth i ent))))
    
17.       )
    
18.     )   
    
19.     (setq i (1+ i))
    
20.   )   ;end repeat
    
21. 
    
22.   (cond
    
23.     ((= "LWPOLYLINE" (cdr (assoc 0 ent)))
    
24.       (setq must (append must (list (assoc 90 ent))))
    
25.     )
    
26.     ((= "SPLINE" (cdr (assoc 0 ent)))
    
27.       (setq must (append must (list (assoc 74 ent))))
    
28.       (foreach ele ent
    
29.         (if (= 11 (car ele))
    
30.           (setq must (append must (list ele)))
    
31.         )
    
32.       )
    
33.     )
    
34.     ((= "DIMENSION" (cdr (assoc 0 ent)))
    
35.       (foreach ele ent
    
36.         (if (or (= 11 (car ele))
    
37.             (= 21 (car ele))
    
38.             (= 31 (car ele))
    
39.             (= 70 (car ele))
    
40.             (= 71 (car ele))
    
41.             (= 1 (car ele))
    
42.             (= 3 (car ele))
    
43.           )
    
44.           (setq must (append must (list ele)))
    
45.         )
    
46.       )
    
47.     )
    
48.   )
    
49.   (print must)
    
50.   (princ)
    
51. )

(defun c:tt( / del_ent ele ent i must new_ent)<br />   (setq ent (entget (car (entsel "\n選擇一個圖元"))))       ;得到組碼<br />   (setq i 0 must '())                ;初始化<br />   (repeat (length ent)<br />     (setq del_ent (vl-remove (nth i ent) ent))        ;測試刪除  <br />     (setq new_ent (entmake del_ent))                   ;測試生成<br />     (if (= 10 (car (nth i ent)))<br />       (progn<br />         (setq must (append must (list (nth i ent))))<br />         (if new_ent <br />           (entdel (entlast))<br />         )<br />       )<br />       (if new_ent    <br />         (entdel (entlast))  <br />         (setq must (append must (list (nth i ent))))<br />       )<br />     )    <br />     (setq i (1+ i))<br />   )   ;end repeat<br /> <br />   (cond<br />     ((= "LWPOLYLINE" (cdr (assoc 0 ent)))<br />       (setq must (append must (list (assoc 90 ent))))<br />     )<br />     ((= "SPLINE" (cdr (assoc 0 ent)))<br />       (setq must (append must (list (assoc 74 ent))))<br />       (foreach ele ent<br />         (if (= 11 (car ele))<br />           (setq must (append must (list ele)))<br />         )<br />       )<br />     )<br />     ((= "DIMENSION" (cdr (assoc 0 ent)))<br />       (foreach ele ent<br />         (if (or (= 11 (car ele))<br />             (= 21 (car ele))<br />             (= 31 (car ele))<br />             (= 70 (car ele))<br />             (= 71 (car ele))<br />             (= 1 (car ele))<br />             (= 3 (car ele))<br />           )<br />           (setq must (append must (list ele)))<br />         )<br />       )<br />     )<br />   )<br />   (print must)<br />   (princ)<br /> )

htlaser

urings 发表于 2018-9-11 19:29
选择10000个长度100的直线,过滤耗时0.1秒
抛砖引玉

正需要这类软件 收藏了   谢谢

1. ;;==筛选直线小于长度(SXD)=================================================================================================
   
2. (defun c:sxd (/ n rel ss ssdl)
   
3.                 (setq ss (ssget '((0 . "*LINE"))) n 0 ssdl (ssadd))
   
4.         (setq rel (getreal "\n请输入需要选择直线的长度值<0.2>"))
   
5.         (if (or (= rel "") (= rel nil)) (setq rel 0.2))
   
6.         (repeat (sslength ss)
   
7.                 (if (<= (distance (cdr (assoc 10 (entget (ssname ss n)))) (cdr (assoc 11 (entget (ssname ss n))))) rel)
   
8.                         (setq ssdl (ssadd (ssname ss n) ssdl))
   
9.                 )
   
10.                 (setq n (+ n 1))
    
11.         )
    
12.         (if (> (sslength ssdl) 0) (sssetfirst nil ssdl));这个是对已有的选择集进行亮显
    
13.         (princ (strcat "\n\n\n共选择了" (rtos (sslength ssdl)) "条直线！！！"))
    
14.         ;(setq aa (cdr (ssgetfirst)));这个是根据选择的对象创建选择集
    
15.         (prin1)
    
16. )

;;==筛选直线小于长度(SXD)=================================================================================================<br /> (defun c:sxd (/ n rel ss ssdl)<br />                 (setq ss (ssget '((0 . "*LINE"))) n 0 ssdl (ssadd))<br />         (setq rel (getreal "\n请输入需要选择直线的长度值<0.2>"))<br />         (if (or (= rel "") (= rel nil)) (setq rel 0.2))<br />         (repeat (sslength ss)<br />                 (if (<= (distance (cdr (assoc 10 (entget (ssname ss n)))) (cdr (assoc 11 (entget (ssname ss n))))) rel)<br />                         (setq ssdl (ssadd (ssname ss n) ssdl)) <br />                 )<br />                 (setq n (+ n 1))<br />         )<br />         (if (> (sslength ssdl) 0) (sssetfirst nil ssdl));这个是对已有的选择集进行亮显<br />         (princ (strcat "\n\n\n共选择了" (rtos (sslength ssdl)) "条直线！！！"))<br />         ;(setq aa (cdr (ssgetfirst)));这个是根据选择的对象创建选择集<br />         (prin1)<br /> )

t18-13nil

没有长度这个组码

urings

选择10000个长度100的直线,过滤耗时0.1秒
抛砖引玉

1. (defun c:tt ( / dis l len mnd mxd t0 tol un x)
   
2.   (setq tol 0.000001)                  ; 精度
   
3.   (setq dis 100)                       ; 长度
   
4.   (setq mxd (+ dis tol))               ; 最大长度
   
5.   (setq mnd (- dis tol))               ; 最小长度
   
6.   (and
   
7.     (setq un (vl-catch-all-apply 'ssget '(((0 . "LINE")))))
   
8.     (vl-catch-all-error-p un)
   
9.     (setq un nil)
   
10.   )                                    ; 获取选择集
    
11.   (setq t0 (* 86400 (getvar "TDUSRTIMER"))) ; 选择完成进入耗时
    
12.   (and
    
13.     un
    
14.     (repeat (setq len (sslength un))
    
15.       (setq l (cons (ssname un (setq len (1- len))) l))
    
16.     )
    
17.   )                                    ; 获取图元表
    
18.   (setq un nil)                        ; 清空选择集
    
19.   (setq l (vl-remove-if-not '(lambda (x)
    
20.                                (setq x (entget x))
    
21.                                (setq x (distance (cdr (assoc 10 x)) (cdr (assoc 11 x))))
    
22.                                (and
    
23.                                  (< x mxd)
    
24.                                  (> x mnd)
    
25.                                )
    
26.                              ) l
    
27.           )
    
28.   )
    
29.   (setq t0 (- (* 86400 (getvar "TDUSRTIMER")) t0))
    
30.   (prompt (strcat "\n过滤耗时 " (rtos t0 2 3) " 秒"))
    
31.   (foreach x l
    
32.     (redraw x 3)
    
33.   )
    
34.   (princ)
    
35. )

(defun c:tt ( / dis l len mnd mxd t0 tol un x)<br />   (setq tol 0.000001)                  ; 精度<br />   (setq dis 100)                       ; 长度<br />   (setq mxd (+ dis tol))               ; 最大长度<br />   (setq mnd (- dis tol))               ; 最小长度<br />   (and<br />     (setq un (vl-catch-all-apply 'ssget '(((0 . "LINE")))))<br />     (vl-catch-all-error-p un)<br />     (setq un nil)<br />   )                                    ; 获取选择集<br />   (setq t0 (* 86400 (getvar "TDUSRTIMER"))) ; 选择完成进入耗时<br />   (and<br />     un<br />     (repeat (setq len (sslength un))<br />       (setq l (cons (ssname un (setq len (1- len))) l))<br />     )<br />   )                                    ; 获取图元表<br />   (setq un nil)                        ; 清空选择集<br />   (setq l (vl-remove-if-not '(lambda (x)<br />                                (setq x (entget x))<br />                                (setq x (distance (cdr (assoc 10 x)) (cdr (assoc 11 x))))<br />                                (and<br />                                  (< x mxd)<br />                                  (> x mnd)<br />                                )<br />                              ) l<br />           )<br />   )<br />   (setq t0 (- (* 86400 (getvar "TDUSRTIMER")) t0))<br />   (prompt (strcat "\n过滤耗时 " (rtos t0 2 3) " 秒"))<br />   (foreach x l<br />     (redraw x 3)<br />   )<br />   (princ)<br /> )

依然小小鸟

你最近是不是在学习lisp呢  你是看什么视频或者书籍呢 能推荐一下吗

urings

htlaser 发表于 2018-9-11 22:04
正需要这类软件 收藏了   谢谢

已点支持
改动了两点
1.先设置参数(长度),再选择实体
2.不创建两个选择集,在原选择集上删除不符合的实体

1. (defun c:tt (/ dis l len n tol un un2 x)
   
2.   (setq tol 0.000001)                  ; 精度
   
3.   (setq dis 0.1)                       ; 默认最大长度
   
4.   (and
   
5.     (setq un2 (vl-catch-all-apply 'getreal '("\n请输入线段最大长度<0.1>:")))
   
6.     (vl-catch-all-error-p un2)
   
7.     (setq un2 -1)
   
8.   )
   
9.   (and
   
10.     (not un2)
    
11.     (setq un2 dis)
    
12.   )                                    ; 获取长度(字符串中的0.1要和默认值一致)
    
13.   (and
    
14.     (not (minusp un2))                 ; 长度不为负数
    
15.     (setq un (vl-catch-all-apply 'ssget '(((0 . "LINE")))))
    
16.     (vl-catch-all-error-p un)
    
17.     (setq un nil)
    
18.   )                                    ; 获取选择集
    
19.   (and
    
20.     un
    
21.     (progn
    
22.       (setq dis (+ un2 tol))           ; 长度加精度
    
23.       (repeat (setq len (sslength un))
    
24.         (setq len (1- len))
    
25.         (setq n (ssname un len))
    
26.         (setq x (entget n))
    
27.         (and
    
28.           (> (distance (cdr (assoc 10 x)) (cdr (assoc 11 x))) dis) ; 条件(可以自己更改)
    
29.           (setq l (cons n l))
    
30.         )
    
31.       )
    
32.       (foreach n l
    
33.         (setq un (ssdel n un))         ; 从选择集中删除不符合的实体
    
34. 
    
35.       )
    
36.       (sssetfirst nil un)              ; 夹点显示
    
37.       (prompt (strcat "\n共找到 " (itoa (sslength un)) " 个实体"))
    
38.     )
    
39.   )
    
40.   (setq un nil)                        ; 清空选择集
    
41.   (princ)
    
42. )

(defun c:tt (/ dis l len n tol un un2 x)<br />   (setq tol 0.000001)                  ; 精度<br />   (setq dis 0.1)                       ; 默认最大长度<br />   (and<br />     (setq un2 (vl-catch-all-apply 'getreal '("\n请输入线段最大长度<0.1>:")))<br />     (vl-catch-all-error-p un2)<br />     (setq un2 -1)<br />   )<br />   (and<br />     (not un2)<br />     (setq un2 dis)<br />   )                                    ; 获取长度(字符串中的0.1要和默认值一致)<br />   (and<br />     (not (minusp un2))                 ; 长度不为负数<br />     (setq un (vl-catch-all-apply 'ssget '(((0 . "LINE")))))<br />     (vl-catch-all-error-p un)<br />     (setq un nil)<br />   )                                    ; 获取选择集<br />   (and<br />     un<br />     (progn<br />       (setq dis (+ un2 tol))           ; 长度加精度<br />       (repeat (setq len (sslength un))<br />         (setq len (1- len))<br />         (setq n (ssname un len))<br />         (setq x (entget n))<br />         (and<br />           (> (distance (cdr (assoc 10 x)) (cdr (assoc 11 x))) dis) ; 条件(可以自己更改)<br />           (setq l (cons n l))<br />         )<br />       )<br />       (foreach n l<br />         (setq un (ssdel n un))         ; 从选择集中删除不符合的实体<br /> <br />       )<br />       (sssetfirst nil un)              ; 夹点显示<br />       (prompt (strcat "\n共找到 " (itoa (sslength un)) " 个实体"))<br />     )<br />   )<br />   (setq un nil)                        ; 清空选择集<br />   (princ)<br /> )

htlaser

urings 发表于 2018-9-12 10:07
已点支持
改动了两点
1.先设置参数(长度),再选择实体

看到了，谢谢。

张大锤

urings 发表于 2018-9-12 10:07
已点支持
改动了两点
1.先设置参数(长度),再选择实体

谢谢你~ 很感谢

guankuiwu

不错不错！