点击标注获取连续的标注选择集
想要达到这样的效果以下为尝试写的但bug很多看网友们有没有解决办法
(defun c:tKK(/ENTLIST ENTLIST2 SS1 SECONDIM10PT 42PT);;SLECTNEW
(PRINC "\n单选标注")
(SETQ ENTlist (CAR(entsel)))
(setq SECONDIM (ssget "w" (CAR (CKZB)) (CADR (CKZB)) '((-4 . "<AND")(0 . "DIMENSION")(-4 . "AND>"))));;根据当前窗口进行过滤
(SETQ SS1 (ss2list SECONDIM))
(SETQ SLECTNEW (ssadd )
SLECTNEW (ssadd entlist SLECTNEW);;;将自身加入选择集
entlist(LISTentlist )
)
(WHILE ENTLIST;;DIMGL函数后若返回图元名则继续循环
(setq ss1 (REMOVEINDEX entlist ss1)
10PT (CAR (GET11/42PIONT ( CAR ENTlist)));;取得标注右端点
42PT (CADR (GET11/42PIONT ( CAR ENTlist)));;取得标注长度
)
(SETQENTLIST (DIMGL 10PT 42PT ss1));;;获得共用点标注图元表
(IF (=(LENGTH ENTLIST)2 );;;若从连续标注中间选择 则返回两个图元进行嵌套循环
(progn
(setq entlist2 ( cdr entlist))
(while entlist2
(PROGN
(foreach X ENTLIST2 (SETQ SLECTNEW (ssadd X SLECTNEW)));;小循环中加入选择集即一个方向
(setq ss1 (REMOVEINDEX entlist2 ss1)
10PT (CAR (GET11/42PIONT ( CAR ENTlist2)))
42PT (CADR (GET11/42PIONT ( CAR ENTlist2)))
)
(SETQENTLIST2 (DIMGL 10PT 42PT ss1))
)
)
)
)
(foreach X ENTLIST (SETQ SLECTNEW (ssadd X SLECTNEW)))
)
(sssetfirst nil SLECTNEW)
(prin1)
)
;;选择集转为图元列表
(defun ss2list( ss / SS2)
(if (= 'PICKSET (type ss))
(reverse (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
)
)
;;说明:根据已有标注左右端点返回相邻标注图元名表
;;参数:10PT:
;;参数:42PT:
;;参数:ss1:
;;返回:图元名表
(defun DIMGL ( 10PT 42PT ss1 /i RPOINT LENGTHDIM SS2) ;;
(SETQI 0
SS2 NIL
)
(repeat (LENGTH ss1)
(SETQ RPOINT (CAR(GET11/42PIONT(NTH I SS1)))
LENGTHDIM(CADR(GET11/42PIONT(NTH I SS1)))
SUMLENGTH (+ LENGTHDIM 42PT)
)
(COND
;((OR(EQUAL RPOINT 10PT ) (EQUAL LENGTHDIM 42PT ) ) (SETQ SS2 (CONS (NTH I SS1) SS2)));;获取自身
;;(EQUAL (DISTANCE RPOINT 10PT) SUMLENGTH 10) (EQUAL (DISTANCE RPOINT 10PT) 0 10))
((OR(EQUAL (DISTANCE RPOINT 10PT) 42PT 5) (EQUAL (DISTANCE RPOINT 10PT) LENGTHDIM 5)) (SETQ SS2 (CONS (NTH I SS1) SS2)));;获取左右两边
)
(SETQ I (1+ I))
)
SS2
)
;;说明:根据图元名返回左右端点
;;参数:ENTNAME:
;;返回:
(defun GET11/42PIONT ( ENTNAME /);10POINT 42POINT
(SETQ10POINT (Cdr(Assoc 10 (Entget ENTNAME)))
42POINT (Cdr(Assoc 42 (Entget ENTNAME)))
)
(LIST 10POINT 42POINT)
)
;;〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
;;说明:根据一个表删除另一个表内容
;;参数:LST1:
;;参数:LST:
;;返回:删除后的表
(defun REMOVEINDEX ( LST1LST / )
(foreach xLST1 (setq LST (vl-remove x LST)))
)
;;说明:获取当前窗口左下角及右上角
;;返回:
(defun CKZB (/ CTR SIZE SCREEN SCALE XSIZE RT LB)
;(command "_.UCS" "V")
(setq CTR (getvar "VIEWCTR"))
(setq SIZE (getvar "VIEWSIZE"))
(setq SCREEN (getvar "SCREENSIZE"))
(setq SCALE (/ (car SCREEN) (cadr SCREEN)))
(setq XSIZE (* SCALE SIZE))
(setq RT (list (+ (car CTR) (/ XSIZE 2)) (+ (cadr CTR) (/ SIZE 2))))
(setq LB (list (- (car CTR) (/ XSIZE 2)) (- (cadr CTR) (/ SIZE 2))))
;(command "_.UCS" "")
(LIST LB RT)
)
又是反编译代码 留个脚印！
页:
[1]