taoyi0727 发表于 2019-9-29 20:33:33

http://bbs.mjtd.com/thread-177580-1-1.html

669423907 发表于 2019-9-30 13:51:38

wyl219 发表于 2019-9-15 22:43
能实现功能,按空格退出命令,按esc也能退出,但是不会取消亮显,可以参考一下.

非常感谢wyl219大师的热情帮助,程序很好,我试着改一下

llsheng_73 发表于 2019-9-30 17:02:51

人家的矩形是可以只有部分在屏幕范围内,那样就矩形内屏幕上一点任意方向都能选到这个矩形的了。。。

669423907 发表于 2019-9-30 21:12:40

llsheng_73 发表于 2019-9-30 17:02
人家的矩形是可以只有部分在屏幕范围内,那样就矩形内屏幕上一点任意方向都能选到这个矩形的了。。。

是呃,我还没注意到

669423907 发表于 2019-9-30 21:15:53

wyl219 发表于 2019-9-15 22:43
能实现功能,按空格退出命令,按esc也能退出,但是不会取消亮显,可以参考一下.

忘了要适应不完全在屏幕上的矩形,方便改一下吗?

wyl219 发表于 2019-10-5 15:01:30

669423907 发表于 2019-9-30 21:15
忘了要适应不完全在屏幕上的矩形,方便改一下吗?

我也是刚知道原来不在屏幕上的图形用栏选选不到.
当然可以实现,通过上下左右获取四个选择集,然后将其合并,就能得到点四周所有的多段线对象,然后利用黄老师的两个函数判断点是否在多段线内.通过这个方式获取选择集,能解决不完全在屏幕上的矩形,但是不能解决完全不在屏幕上的矩形.
如果想要选完全不在屏幕上的图形,应该可以用ssget "x"全选所有的多段线,然后按原方式筛选,不过这样太慢了,不知道有没有别的好办法.
;|
说明:根据鼠标位置亮显离自己最近的封闭四边形,用esc退出命令,建议修改error函数,当esc退出命令时关闭亮显.
v2:可以亮显不完全在屏幕内的矩形
|;
(defun c:ttt ( / wyl:err old_error fill pt_tmp pt_x1 pt_x2 pt_y1 pt_y2 ss_x1 ss_x2 ss_y1 ss_y2ss_new i enen_selold en_sel lst_pttoobj_dist obj bo lst_ss_sel ss_sel )
;(defun c:ttt ( /)
(vl-load-com)
(setq old_error *error*)
;(setq *error* wyl:err) ;可以修改为自己的error函数
;start部分结束
(setq fill (list '(0 . "LWPOLYLINE") '(70 . 1)));筛选条件为闭合的多段线
(setq bo t)
(while bo
    (if (= (car (setq pt_tmp (grread t 1 ))) 5);当获取到的为坐标点时
      ;(setq pt_tmp (getpoint));debug
      (progn
      (setq pt_tmp (cadr pt_tmp))
      (setq pt_x1 (list(car pt_tmp) (expt 10 9) 0.0)
          pt_x2 (list (car pt_tmp) (expt -10 9) 0.0)
          pt_y1 (list   (expt 10 9) (cadr pt_tmp) 0.0)
          pt_y2 (list(expt -10 9) (cadr pt_tmp) 0.0)
      )
      (setq ss_x1 (ssget "F" (list pt_x1 pt_tmp) fill)
          ss_x2 (ssget "F" (list pt_x2 pt_tmp) fill)
          ss_y1 (ssget "F" (list pt_y1 pt_tmp) fill)
          ss_y2 (ssget "F" (list pt_y2 pt_tmp) fill)
      );获取四个方向的闭合多段线
      (setq ss_sel (wyl:joinss "" (list ss_x1 ss_x2 ss_y1 ss_y2)));建立一个新的选择集,存储上面所有的选择集的内容
      (setq ss_x1 nil
          ss_x2 nil
          ss_y1 nil
          ss_y2 nil
      )
      (if (and ss_sel (>(sslength ss_sel) 0));如果选择集不为空
          (progn
            (setq ss_new (ssadd));新建一个选择集
            (setq lst_ss_sel (wyl:ss2ptlist ss_sel -1 ));把选择集变成列表,方便使用foreach
            (setq en1 (nth 0 lst_ss_sel))
            (foreach en1 lst_ss_sel
            (if (PtInorOut1 (HH:PtLists en1) pt_tmp);如果点在多段线内
                (ssadd en1 ss_new)
            );endif
            );endforeach
            (setq ss_sel nil)
            (cond
            ((= 1 (sslength ss_new));如果只有一个候选项
                (progn
                  (setq en_selold en_sel);备份一下上次亮显的对象
                  (if (and (setq en_sel (ssnamess_new 0 ))
                        (= (vl-princ-to-string en_selold) (vl-princ-to-string en_sel)));如果两次获取到的对象相同,那么
                  (redrawen_sel3);直接将他亮显
                  (progn ;else
                      (redrawen_sel3)
                      (ifen_selold (redrawen_selold4));取消原来的亮显
                  )
                  );endif
                ))
            ((>(sslength ss_new) 1);如果不止一个
                (setq lst_pttoobj_dist nil)
                (repeat (setq i (sslength ss_new));判断距离
                  (setq i (1- i)
                  en (ssnamess_new i)
                  obj (vlax-ename->vla-object en)
                  )
                  (setq lst_pttoobj_dist (append (list (list (distance (vlax-curve-getClosestPointTo obj pt_tmp) pt_tmp) en)) '() lst_pttoobj_dist))
                );endrepeat
                (setq lst_pttoobj_dist (vl-sort lst_pttoobj_dist '(lambda (x y) (< (car x) (car y)))) );对距离排序
                (setq en_selold en_sel);备份一下上次亮显的对象
                (if (and ;lst_pttoobj_dist
                      (setq en_sel (cadr (nth 0 lst_pttoobj_dist) ))
                      (= (vl-princ-to-string en_selold) (vl-princ-to-string en_sel));直接判断是不相等的
                  );如果两次获取到的对象相同,那么
                  (redrawen_sel3);将他亮显
                  (progn ;else
                  (redrawen_sel3)
                  (if en_selold (redrawen_selold4));取消原来的亮显
                  )
                );endif
            );end progn
            );endcond
          ));end if
      );end progn
    );endif
    (if(equal (grread t 1 ) '(2 32)) ;如果输入空格
      (progn
      (if en_sel (redrawen_sel4));取消对象亮显
      (setq bo nil));结束循环
    )
);endwhile
;end部分开始
(setvar "cmdecho" 1)
(setq *error* old_error)
)
;;164.40 [功能] 点在封闭多段线内返回T,其余nilBy 狂刀(见175)
;;本程序为狂刀思想,并非源程序
;;(PtInorOut1 ((HH:PtLists (car(entsel))) (getpoint))
(defun PtInorOut1 (pts pt / P1 P2 PI)
(setq PI 3.14159);不知道cad本身有没有这个常量
(setq pts (MAPCAR '(LAMBDA (p1 p2) (REM (- (ANGLE pt p1) (ANGLE pt p2)) PI))
            (CONS (LAST pts) pts)
            pts
            )
)
; (equal (ABS (APPLY '+ pts)) PI ) ;原来的语句不含容错,所以可能会出错
(equal (ABS (APPLY '+ pts)) PI0.00001)
)
;;164.3 [功能] 多段线端点列表
;;示例(HH:PtLists (car (entsel)))
(defun HH:PtLists (en)
(mapcar 'cdr
    (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
)
)
;;选择集转为dxf列表
;;说明:传入选择集,将对应的组码返回
;;参数:ss:选择集
;;参数:dxf:组码,例如10代表插入点,0代表对象类型,2代表对象名,8代表图层,-1是图元名
;;返回:列表
(defun wyl:ss2ptlist ( ss dxf / n i elist )
;(defun ss2ptlist ( ss / )
(setq n (if (= (type ss) 'Pickset) (sslength ss) 0)
    elist '()
)
(repeat n
    (setq elist (cons(cdr (assoc dxf(entget (ssname ss (setq n (1- n))))))elist))
)
)
;|
说明:将多个选择集合并后返回,选择集可以为空
参数:ss要被合并进去的选择集,可以用""占位.
lstss,多个选择集组成的列表
返回值:合并后的选择集
|;
(defun wyl:joinss( ss lst_ss / )
(if (or (not ss ) (= "" ss))
    (setq ss (ssadd)))
(foreach ss1 lst_ss
    (if ss1 ;如果选择集不为空
      (progn
      (repeat (setq i (sslength ss1))
          (setq i (1- i))
          (ssadd (ssname ss1 i) ss)
      );endrepeat
      );endprogn
    );endif
);end foreach
ss
)
(princ "加载成功,命令名ttt")
(princ)

669423907 发表于 2019-10-10 08:22:48

wyl219 发表于 2019-10-5 15:01
我也是刚知道原来不在屏幕上的图形用栏选选不到.
当然可以实现,通过上下左右获取四个选择集,然后将其合 ...

再次非常感谢wyl219大师的热情帮助
页: 1 2 [3]
查看完整版本: 如何自动选中并亮显包围光标点的矩形?