扩展数据选择求帮助！

yaokui25

最近遇到个棘手的问题，就是选择含有相同扩展数据的所有对象
今天研究了一天也没弄出个结果来，肯定大家帮帮忙！
说明内容在附件里
下面是附件里的内容《某一条线上的所扩展数据》
我想通过点选某条线段线，拾取该线上的扩展数据。根据 PMF_GROUP_HEADER_KEGAKI 中最后一趟代码的关键字 P STUD=M24×35 《关键字P后面是变化的   例如 STUD=M24×35G》来选中所有对象。

PMF_YOUSETSU_GROUPNAME
1000      PMF_1GA42U_Kegaki_21
PMF_YOUSETSU_FIGURE
1000      0
1040      542.802
·
·
·
PMF_GROUP_HEADER_KEGAKI
1000      F
1000      P STUD=M24×35

下面是根据 院长 和 llsheng_73 两位前辈的代码拼凑起来的
基本实现了我所要的功能但是有一点比较头疼的问题就是
STUD=M24×35和STUD=M24×35G 无法分开识别
如果选择STUD=M24×35 则 STUD=M24×35G 也会别一同选择上！
也就是说获取 P 后面的文字内用完全一致的对象！
(defun C:kkk (/ en e i s)
  (setq s1 (car (entsel "\n ***** 选择文本: "))
        tx (cdr (assoc 1 (entget s1))))
(if(setq i 0 s (ssget "X"'((0 . "*LINE")(-3("PMF_GROUP_HEADER_KEGAKI")))))
    (progn
      (repeat(sslength s)
         (setq e(ssname s i))
          (if(vl-string-search (strcat tx)
            (apply'strcat(mapcar'cdr(vl-remove-if'(lambda(x)(/=(car x)1000))(cdr(last(assoc -3(entget e'("PMF_GROUP_HEADER_KEGAKI")))))))))
          (setq i(1+ i))
         (ssdel e s)
         )
        )
       (sssetfirst nil s)
      (if(>(setq i(sslength s)) 0)
        (princ (strcat "【" (itoa i) "】"tx" 被选择了."))
      )
    )
        (princ (strcat "\n ***** "tx" 不存在. *****"))
  )
(princ)
)

xyp1964

yaokui25

希望大家不要被我下面的代码迷惑
我的目的是点选带有扩展数据"MF_GROUP_HEADER_KEGAKI" 根据它所含有的"STUD=M24×35"关键字，来选择所有对象.
希望大家有时间的话能看看我上传的附件，里面有详细说明。

下面是自己做的，仅供参考！
(defun C:K333 (/ dxf ent i rt ss)  (setvar "cmdecho" 0)
  (setvar "cmdecho" 0)
  (setq ss (ssget "X" '((-3 ("MF_GROUP_HEADER_KEGAKI")))))
  (if (not (null ss))
    (progn
      (setq i  (sslength ss)
            rt (ssadd)
      )
      (repeat i
        (setq ent (ssname ss (setq i (1- i)))
              dxf (entget ent '("MF_GROUP_HEADER_KEGAKI"))
              dxf (assoc -3 dxf)
        )
        (if (vl-string-search "STUD=M24×35" (cdr (cadadr dxf)))
          (ssadd ent rt)
        )
      )
      (princ (strcat "\n 〓共选择了【" (itoa (sslength rt)) "】个对象〓"))
      (sssetfirst nil rt)
    )
  )

  (setvar "cmdecho" 1)
  (princ)
)

springwillow

虑选扩展信息样例如下：

2. (setq ss (ssget "X" (list '(0 . "LWPOLYLINE")'(8 . "SSFW") (list -3 (list "CBJ" (cons 1000 (rtos n0 2 0)))))))

(setq ss (ssget "X" (list '(0 . "LWPOLYLINE")'(8 . "SSFW") (list -3 (list "CBJ" (cons 1000 (rtos n0 2 0)))))))

yaokui25

springwillow 发表于 2015-12-17 20:20
虑选扩展信息样例如下：

谢谢您的回答，能否帮我改改上面的代码

springwillow

yaokui25 发表于 2015-12-17 20:28
谢谢您的回答，能否帮我改改上面的代码

2. (setq ss (ssget "X" (list(list -3 (list "PMF_GROUP_HEADER_KEGAKI")))))

(setq ss (ssget "X" (list(list -3 (list "PMF_GROUP_HEADER_KEGAKI")))))

yaokui25

springwillow 发表于 2015-12-17 20:39

我也是这么改的，还是选不中
PMF_GROUP_HEADER_KEGAKI   <存在两行数据只能选中 F>
1000      F
1000      P STUD=M24×35

xyp1964

2. ;; tt(过滤扩展数据)
   
3. (defun c:tt ()
   
4.   (defun abc (s1 / d3 lst)
   
5.     (setq d3 (xyp-DXF -3 s1))
   
6.     (setq lst (mapcar 'cdr d3))
   
7.     (setq lst (apply 'append lst))
   
8.     (mapcar 'cdr lst)
   
9.   )
   
10.   (setq s1  (car (entsel "\n选择文本: "))
    
11.         tx  (xyp-DXF 1 s1)
    
12.         i   -1
    
13.         ss1 (ssadd)
    
14.   )
    
15.   (if (setq ss (ssget '((0 . "LINE") (8 . "xdata"))))
    
16.     (progn
    
17.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
18.         (if (and (setq lst (abc s1))
    
19.                  (vl-some '(lambda (x) (vl-string-search x tx)) lst)
    
20.             )
    
21.           (ssadd s1 ss1)
    
22.         )
    
23.       )
    
24.       (sssetfirst nil ss1)
    
25.     )
    
26.   )
    
27.   (princ)
    
28. )

;; tt(过滤扩展数据)<br /> (defun c:tt ()<br />   (defun abc (s1 / d3 lst)<br />     (setq d3 (xyp-DXF -3 s1))<br />     (setq lst (mapcar 'cdr d3))<br />     (setq lst (apply 'append lst))<br />     (mapcar 'cdr lst)<br />   )<br />   (setq s1  (car (entsel "\n选择文本: "))<br />         tx  (xyp-DXF 1 s1)<br />         i   -1<br />         ss1 (ssadd)<br />   )<br />   (if (setq ss (ssget '((0 . "LINE") (8 . "xdata"))))<br />     (progn<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (if (and (setq lst (abc s1))<br />                  (vl-some '(lambda (x) (vl-string-search x tx)) lst)<br />             )<br />           (ssadd s1 ss1)<br />         )<br />       )<br />       (sssetfirst nil ss1)<br />     )<br />   )<br />   (princ)<br /> )

yaokui25

xyp1964 发表于 2015-12-17 22:08

真心谢谢版主大人，由于电脑的系统原因，您的通用函数加载之后是乱码。恳请您能否提供一个完整程序。今天废了好大劲也没弄出来。

xyp1964

2. ;; tt(过滤扩展数据)
   
3. (defun c:tt ()
   
4.   (defun abc (s1 / lst)
   
5.     (setq lst (mapcar 'cdr (cdr (assoc -3 (entget s1 '("*"))))))
   
6.     (mapcar 'cdr (apply 'append lst))
   
7.   )
   
8.   (setq s1  (car (entsel "\n选择文本: "))
   
9.         tx  (cdr (assoc 1 (entget s1)))
   
10.         i   -1
    
11.         ss1 (ssadd)
    
12.   )
    
13.   (if (setq ss (ssget '((0 . "LINE") (8 . "xdata"))))
    
14.     (progn
    
15.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
16.         (if (and (setq lst (abc s1))
    
17.                  (vl-some '(lambda (x) (vl-string-search x tx)) lst)
    
18.             )
    
19.           (ssadd s1 ss1)
    
20.         )
    
21.       )
    
22.       (sssetfirst nil ss1)
    
23.     )
    
24.   )
    
25.   (princ)
    
26. )

;; tt(过滤扩展数据)<br /> (defun c:tt ()<br />   (defun abc (s1 / lst)<br />     (setq lst (mapcar 'cdr (cdr (assoc -3 (entget s1 '("*"))))))<br />     (mapcar 'cdr (apply 'append lst))<br />   )<br />   (setq s1  (car (entsel "\n选择文本: "))<br />         tx  (cdr (assoc 1 (entget s1)))<br />         i   -1<br />         ss1 (ssadd)<br />   )<br />   (if (setq ss (ssget '((0 . "LINE") (8 . "xdata"))))<br />     (progn<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (if (and (setq lst (abc s1))<br />                  (vl-some '(lambda (x) (vl-string-search x tx)) lst)<br />             )<br />           (ssadd s1 ss1)<br />         )<br />       )<br />       (sssetfirst nil ss1)<br />     )<br />   )<br />   (princ)<br /> )