664571221 发表于 2019-11-20 10:37:05

大神看下，求输入tt，选着一个填充然后再框选，选出和第一次选择的填充面积相同填充

大神看下，求输入tt，选着一个填充然后再框选，选出和第一次选择的填充面积相同的填充

wyl219 发表于 2019-11-21 17:07:31

(defun c:tt ( / fuzz getarea area_tmp ss en_now)
      (vl-load-com)
      (setq fuzz 0) ;设置容错值
      (setq getarea (function (lambda (x) (Vlax-Get (Vlax-Ename->Vla-Object x ) 'Area))))
      (setq en (car (entsel "\n选择样本")))
      (while (not (and en (equal"HATCH" (cdr (assoc 0 (entget en))))) )
                        (setq en (car (entsel "\n样本不为填充,请重新选择样本")))
      )
      (setq area_tmp (apply getarea (list en)))
      (setq ss (ssget '((0 . "HATCH"))));框选对象
      (repeat (setq i (sslength ss))
                (setq en_now (ssname ss (setq i (1- i))))
                (if (not (equal area_tmp (apply getarea (list en_now)) fuzz));如果面积不相等
                        (ssdel en_now ss);从选择集中删除
                        ;(redraw en_now 3);将对象亮显
                )
      )
      (command "SELECT" ss "" );选择对象
)
(princ)

需要删除就e空格 p空格

wyl219 发表于 2019-11-21 11:09:32

本帖最后由 wyl219 于 2019-11-21 11:28 编辑

加入了样本选择判断,如果选择的不为填充,要求重新选择

(defun c:tt ( / fuzz getarea area_tmp ss en_now)
        (vl-load-com)
        (setq fuzz 0) ;设置容错值
        (setq getarea (function (lambda (x) (Vlax-Get (Vlax-Ename->Vla-Object x ) 'Area))))
        (setq en (car (entsel "\n选择样本")))
        (while (not (and en (equal"HATCH" (cdr (assoc 0 (entget en))))) )
                        (setq en (car (entsel "\n样本不为填充,请重新选择样本")))
        )
        (setq area_tmp (apply getarea (list en)))
        (setq ss (ssget '((0 . "HATCH"))));框选对象
        (repeat (setq i (sslength ss))
                (setq en_now (ssname ss (setq i (1- i))))
                (if (not (equal area_tmp (apply getarea (list en_now)) fuzz));如果面积不相等
                        (ssdel en_now ss);从选择集中删除
                        (redraw en_now 3);将对象亮显
                )
        )
        ;(command "SELECT" ss );选择对象
)
(princ)

wyl219 发表于 2019-11-20 11:13:35


(defun c:tt ( / fuzz getarea area_tmp ss en_now)
        (vl-load-com)
        (setq fuzz 0) ;设置容错值
        (setq getarea (function (lambda (x) (Vlax-Get (Vlax-Ename->Vla-Object x ) 'Area))))
        (setq area_tmp (apply getarea (list (setq en (car (entsel "\n选择样本"))))))
        (setq ss (ssget '((0 . "HATCH"))));框选对象
        (repeat (setq i (sslength ss))
                (setq en_now (ssname ss (setq i (1- i))))
                (if (not (equal area_tmp (apply getarea (list en_now)) fuzz));如果面积不相等
                        (ssdel en_now ss);从选择集中删除
                )
        )
        ;(command "SELECT" ss );选择对象
)
(princ)

wyl219 发表于 2019-11-20 11:15:37

可以在代码中写死fuzz容错值,也可以修改为getint函数交互获得.
最后注释掉的command 命令是为了让你检查的,实际应用的时候用ss这个选择集就行

yoyoho 发表于 2019-11-20 17:36:04

谢谢 !wyl219分享程序!!!!!!

664571221 发表于 2019-11-21 09:04:18

wyl219 发表于 2019-11-20 11:15
可以在代码中写死fuzz容错值,也可以修改为getint函数交互获得.
最后注释掉的command 命令是为了让你检查的 ...

选择样本; 错误: ActiveX 服务器返回错误: 未知名称: "AREA"


大神看下

wyl219 发表于 2019-11-21 11:01:48

664571221 发表于 2019-11-21 09:04
选择样本; 错误: ActiveX 服务器返回错误: 未知名称: "AREA"




是不是选错对象了,比如选中的是直线等没有面积的对象

yoyoho 发表于 2019-11-21 11:14:05

AUTOCAD 2012 测试 O.K.

664571221 发表于 2019-11-21 14:20:41

wyl219 发表于 2019-11-21 11:09
加入了样本选择判断,如果选择的不为填充,要求重新选择

(defun c:tt ( / fuzz getarea area_tmp ss en_no ...

你好大神，最后能不能让这些处于选中的状态，以便我可以删除或者复制移动的操作
页: [1] 2
查看完整版本: 大神看下，求输入tt，选着一个填充然后再框选，选出和第一次选择的填充面积相同填充