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大师的热情帮助