htlaser 发表于 2018-9-6 21:30:47

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

本帖最后由 htlaser 于 2018-9-6 21:34 编辑

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

htlaser 发表于 2018-9-12 01:11:59

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

删除大于一定长度的直线


能不能将这个改成亮显，读代码能力实在太差了。只能看懂小部分。真抱歉又要麻烦您了。(defun c:tt ( / dis l len mnd mxd t0 tol un x)
(setq tol 0.000001)                  ; 精度
(setq dis 100)                     ; 长度
(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)
)
(princ)
)

htlaser 发表于 2018-9-12 09:43:11

本帖最后由 htlaser 于 2018-9-12 09:47 编辑

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 发表于 2018-9-10 17:40:27

本帖最后由 Andyhon 于 2018-9-10 17:57 编辑


Command: sxd1

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

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

Select objects: All 127 found

Select objects:

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

Andyhon 发表于 2018-9-7 10:00:50

Try this

htlaser 发表于 2018-9-9 15:38:14

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

谢谢您 程序还是有问题

htlaser 发表于 2018-9-9 15:39:43

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

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

Andyhon 发表于 2018-9-9 15:58:12

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

htlaser 发表于 2018-9-10 16:32:16

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

筛选出0.4长的线

Andyhon 发表于 2018-9-12 07:54:55

亮显?

亮显那些!?

htlaser 发表于 2018-9-12 09:34:38

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

亮显那些!?

(setq dis 100)                     ; 长度
页: [1] 2 3
查看完整版本: 请帮忙改写成指定长度删除 不小于且大于的不删除。