点击标注获取连续的标注选择集

LXH

想要达到这样的效果

以下为尝试写的但bug很多  看网友们有没有解决办法



(defun c:tKK(/  ENTLIST ENTLIST2 SS1 SECONDIM  10PT 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  (LIST  entlist )
        )
       
        (WHILE ENTLIST;;DIMGL函数后若返回图元名则继续循环
                (setq ss1 (REMOVEINDEX entlist ss1)
                            10PT   (CAR (GET11/42PIONT ( CAR ENTlist)));;取得标注右端点
                            42PT   (CADR (GET11/42PIONT ( CAR ENTlist)));;取得标注长度
                )
               
                (SETQ  ENTLIST (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)))
                                        )                                               
                                  (SETQ  ENTLIST2 (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) ;;
        (SETQ  I   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
        (SETQ  10POINT (Cdr(Assoc 10 (Entget ENTNAME)))
                     42POINT (Cdr(Assoc 42 (Entget ENTNAME)))
        )
        (LIST 10POINT 42POINT)
)


;;〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
;;说明:根据一个表删除另一个表内容
;;参数ST1:
;;参数ST:
;;返回:删除后的表
(defun REMOVEINDEX ( LST1  LST / )
        (foreach x  LST1 (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)
)

你有种再说一遍

又是反编译代码

暮雨晨曦

留个脚印！