请帮忙改写成指定长度删除 不小于且大于的不删除。

htlaser

类似快速选择-直线-长度相同
请帮忙改写成指定长度删除   不小于且大于的不删除。主要用于客户来图，3D图转平面图倒圆角边转CAD图的小边线。

htlaser

Andyhon 发表于 2018-9-10 17:40
Command: sxd1

删除大于一定长度的直线

能不能将这个改成亮显，读代码能力实在太差了。只能看懂小部分。真抱歉又要麻烦您了。

2. (defun c:tt ( / dis l len mnd mxd t0 tol un x)
   
3.   (setq tol 0.000001)                  ; 精度
   
4.   (setq dis 100)                       ; 长度
   
5.   (setq mxd (+ dis tol))               ; 最大长度
   
6.   (setq mnd (- dis tol))               ; 最小长度
   
7.   (and
   
8.     (setq un (vl-catch-all-apply 'ssget '(((0 . "LINE")))))
   
9.     (vl-catch-all-error-p un)
   
10.     (setq un nil)
    
11.   )                                    ; 获取选择集
    
12.   ;(setq t0 (* 86400 (getvar "TDUSRTIMER"))) ; 选择完成进入耗时
    
13.   (and 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) (setq x (entget x)) (setq x (distance (cdr (assoc 10 x)) (cdr (assoc 11 x))))
    
20.         (and (< x mxd) (> x mnd) ) ) l ) )
    
21.   ;(setq t0 (- (* 86400 (getvar "TDUSRTIMER")) t0))
    
22.   ;(prompt (strcat "\n过滤耗时 " (rtos t0 2 3) " 秒"))
    
23.   (foreach x l
    
24.     (redraw x 3)
    
25.   )
    
26.   (princ)
    
27. )

(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 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) (setq x (entget x)) (setq x (distance (cdr (assoc 10 x)) (cdr (assoc 11 x))))<br />         (and (< x mxd) (> x mnd) ) ) l ) )<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 /> )

htlaser

Andyhon 发表于 2018-9-12 07:54
亮显?

亮显那些!?

(defun c:sxdd ( / dis l len mnd mxd t0 tol un x)
  (setq tol 0.05)   ; 类似模糊精度
  (setq dis (getreal "\n请输入需要选择直线的长度值"))  ; 长度  
  (setq mxd (+ dis tol)); 最大长度
  (setq mnd (- dis tol)); 最小长度
  (and(setq un (vl-catch-all-apply 'ssget '(((0 . "LINE")))))
                (vl-catch-all-error-p un)
    (setq un nil)); 获取选择集
  ;(setq t0 (* 86400 (getvar "TDUSRTIMER"))) ; 选择完成进入耗时
  (and un (repeat (setq len (sslength un))
                                         (setq l (cons (ssname un (setq len (1- len))) l)))) ; 获取图元表
  ;(setq un nil)  ; 清空选择集
  (setq l
                (vl-remove-if-not '(lambda (x)
                (setq x (entget x))
    (setq x (distance (cdr (assoc 10 x)) (cdr (assoc 11 x))))
    (and (< x mxd) (> x mnd) ) ) l)
  )
  (setq t0 (- (* 86400 (getvar "TDUSRTIMER")) t0))
  (prompt (strcat "\n过滤耗时 " (rtos t0 2 3) " 秒"))
  (foreach x l
    (redraw x 3))
        (sssetfirst nil  ) ;这里不知道怎么添加
  (princ)
)

Andyhon

Command: sxd1

删除大于一定长度的直线
请输入可容许的最小线段长度==>> 0.395

请输入可容许的最大线段长度==>> 0.405

Select objects: All 127 found

Select objects:

Test OK!
(princ "\n 删除大于一定长度的直线")
  ===>
  (princ "\n 删除介于一定长度的直线")

Andyhon

Try this

htlaser

Andyhon 发表于 2018-9-7 10:00
Try this

谢谢您 程序还是有问题

htlaser

htlaser 发表于 2018-9-9 15:38
谢谢您 程序还是有问题

别找了一个程序 还是有小问题  相同长度 有角度的也是不能被选中 只能加大值。

Andyhon

请贴出错误讯息&配合程序试用图(*.Dwg)

htlaser

Andyhon 发表于 2018-9-9 15:58
请贴出错误讯息&配合程序试用图(*.Dwg)

筛选出0.4长的线

Andyhon

亮显?

亮显那些!?

htlaser

Andyhon 发表于 2018-9-12 07:54
亮显?

亮显那些!?

(setq dis 100)                       ; 长度