Topic: Filtering for Extended Data

[milanp]

Hello everyone. Is it possible to make a selection based on a string (code 1000)? I already have a defined point (application name "Tacka") with a defined point name. When I enter a point number, I want to import a special block to that point. The only thing I found on internet was ssget "X" '((0 . "POINT") (-3 ("APPNAME")))) but I don't know how to filter by point number. Here is the code made so far:

Code: [Select]

(defun C:k1 ( / ss blk n)
(SETVAR "INSUNITS" 4)
(initget "1000 500 2500 250")
  (setq Pitanje
    (cond
      ( (getint
          (strcat "\n Odaberi Razmeru 1:[1000/500/2500/250] <"
            (itoa
              (cond
                (Pitanje)
                ( (setq Pitanje 1000) )
              )
            )">: "
          )
        )
      )
      (Pitanje)
    )
  )
(if (= Pitanje 1000)
 (progn (setq razmera 1))) 
(if (= Pitanje 500)
 (progn (setq razmera 0.5)))
(if (= Pitanje 2500)
 (progn (setq razmera 2.5)))
(if (= Pitanje 250)
 (progn (setq razmera 0.25)))
  (if (and (setq ss (ssget "X" '((0 . "POINT") (-3 ("Tacka")))))
            (setq blk "T62-04 Reviziono okno - poklopac kruzni"))
    (repeat (setq n (sslength ss))
(command "layer" "make" "Top znaci kanalizacija" "")
      (command "_.-insert" blk
                 "_s" razmera
                "_r" 0
                "_none" (cdr (assoc 10 (entget (ssname ss (setq n (1-
n)))))))))
  (princ)
)
 Thanks

[ribarm]

You are feeding INSERT command with point obtained from position of entities from sel. set (POINT entities) and not from XDATA referencing them like you described in your task assignment... To get sel. set with entities with linked/appended XDATA, consider following sub function(s) :

Code - Auto/Visual Lisp: [Select]

1. ;; | -----------------------------------------------------------------------------
2. ;; | SSgetXD
3. ;; | -----------------------------------------------------------------------------
4. ;; | Function : Does an ssget and applies extended entity data check also.
5. ;; | Arguments: 'filtr'    - Selection Set filter criteria
6. ;; |                         Do not give Application Name with 'filtr'
7. ;; |                         as this is given separately in the last parameter
8. ;; |            'XdChkLst' - Xdata condition List to check - list must be in order
9.                              like AppNameLst order is provided
10. ;; |            'RetFmt'   Return Format
11. ;; |                       0 - Selection Set
12. ;; |                       1 - List containing (enames)
13. ;; |
14. ;; |            'AppNameLst'- Application Name List to check
15. ;; | Author   : (C) Rakesh Rao, Singapore
16. ;; | Return   : Selection set matching criteria
17. ;; | Updated  : 24 July 1998
18. ;; | e-mail   : rakesh.rao@4d-technologies.com
19. ;; | Web      : www.4d-technologies.com
20. ;; | -----------------------------------------------------------------------------
21. ;; | Modified : Marko Ribar, d.i.a. (architect)
22. ;; | -----------------------------------------------------------------------------
23.  
24. (defun XD_readX ( ename AppName )
25.   (reverse (cdr (reverse (cddr (assoc AppName (cdr (assoc -3 (entget ename (list "*")))))))))
26. )
27.  
28. (defun SS_getappid ( AppName / filtr ss )
29.  
30.   (setq
31.     AppName (cdr (assoc 2 (tblsearch "APPID" AppName)))
32.     filtr   (append filtr (list (list -3 (list AppName))))
33.     ss      (ssget "_X" filtr)
34.   )
35.  
36.   ss
37. )
38.  
39. (defun SS_getallappids ( / a app appl ss )
40.  
41.   (setq app (cdr (assoc 2 (setq a (tblnext "APPID" t)))))
42.   (setq appl (cons app appl))
43.   (while (setq a (tblnext "APPID"))
44.     (setq app (cdr (assoc 2 a)))
45.     (setq appl (cons app appl))
46.   )
47.   (setq ss (ssadd))
48.   (foreach app appl
49.     (foreach e (if (SS_getappid app) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (SS_getappid app)))))
50.       (ssadd e ss)
51.     )
52.   )
53.  
54.   ss
55. )
56.  
57. (defun SS_SSgetXD ( filtr XdChkLst RetFmt AppNameLst / sss ss i ss1 ssl xdl cnt ename Lst )
58.  
59.   (setq sss (ssadd))
60.   (foreach AppName AppNameLst
61.     (setq
62.       AppName (cdr (assoc 2 (tblsearch "APPID" AppName)))
63.       filtr   (append filtr (list (list -3 (list AppName))))
64.       ss      (ssget "_X" filtr)
65.     )
66.     (if ss
67.       (repeat (setq i (sslength ss))
68.         (if (not (ssmemb (ssname ss (setq i (1- i))) sss))
69.           (ssadd (ssname ss i) sss)
70.         )
71.       )
72.     )
73.   )
74.  
75.   (if (= RetFmt 0)
76.     (setq ss1 (ssadd))
77.   )
78.  
79.   (if sss
80.     (progn
81.       (setq
82.         ssl      (sslength sss)
83.         cnt      0
84.       )
85.       (repeat ssl
86.         (setq
87.           ename (ssname sss cnt)
88.           cnt   (1+ cnt)
89.         )
90.         (foreach AppName AppNameLst
91.           (setq xdl (cons (XD_readX ename AppName) xdl))
92.         )
93.         (setq xdl (reverse xdl))
94.         (if xdl
95.           (progn
96.             (if (equal xdl XdChkLst)
97.               (if (= RetFmt 0)
98.                 (ssadd ename ss1)
99.                 (setq Lst (cons ename Lst))
100.               )
101.             )
102.             (setq xdl nil)
103.           )
104.         )
105.       )
106.     )
107.   )
108.  
109.   (if (= RetFmt 0)
110.     (if (> (sslength ss1) 0)
111.       ss1
112.       nil
113.     )
114.     Lst
115.   )
116. )
117.  
118. ;;; (acet-xdata-set (list txtename "ATT-TEXTMASK1" (list (list "BlockName1" "OTVOR1" 1000)))) ;;;
119. ;;; (acet-xdata-set (list txtename "ATT-TEXTMASK2" (list (list "BlockName2" "OTVOR2" 1000)))) ;;;
120. ;;; (setq ss (SS_SSgetXD '((0 . "TEXT")) '(((1000 . "BLOCKNAME1") (1000 . "OTVOR1")) ((1000 . "BLOCKNAME2") (1000 . "OTVOR2"))) 0 '("ATT-TEXTMASK1" "ATT-TEXTMASK2"))) ;;;
121.  

But to do exatly you described, after getting sel. set with entities, you'll have to step once again through it and apply XDATA values to INSERT command statement...

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo ( / *error* xdfunc cmde un Pitanje ss sourceent enx ss blk i pt )
2.  
3.   (defun *error* ( m )
4.     (if (= 8 (logand 8 (getvar 'undoctl)))
5.       (if command-s
6.         (command-s "_.UNDO" "_E")
7.         (vl-cmdf "_.UNDO" "_E")
8.       )
9.     )
10.     (if cmde
11.       (setvar 'cmdecho cmde)
12.     )
13.     (if un
14.       (setvar 'insunits un)
15.     )
16.     (if m
17.       (prompt m)
18.     )
19.     (princ)
20.   )
21.  
22.   (defun xdfunc ( lst )
23.     (reverse (cdr (reverse (cddr lst))))
24.   )
25.  
26.   (setq cmde (getvar 'cmdecho))
27.   (setvar 'cmdecho 0)
28.   (if (= 8 (logand 8 (getvar 'undoctl)))
29.     (vl-cmdf "_.UNDO" "_E")
30.   )
31.   (vl-cmdf "_.UNDO" "_G")
32.   (setq un (getvar 'insunits))
33.   (setvar 'insunits 4)
34.   (initget "1000 500 2500 250")
35.   (setq Pitanje
36.     (cond
37.       ( (getint
38.           (strcat "\n Odaberi Razmeru 1:[1000/500/2500/250] <"
39.             (itoa
40.               (cond
41.                 (Pitanje)
42.                 ( (setq Pitanje 1000) )
43.               )
44.             )">: "
45.           )
46.         )
47.       )
48.       (Pitanje)
49.     )
50.   )
51.   (setq razmera
52.     (cond
53.       ( (= Pitanje 1000) 1 )
54.       ( (= Pitanje 500) 0.5 )
55.       ( (= Pitanje 2500) 2.5 )
56.       ( (= Pitanje 250) 0.25 )
57.     )
58.   )
59.   (if
60.     (and
61.       (setq sourceent (car (entsel "\nPick source entity with XDATA to obtain adequate filtering data for getting selection set with similar entities that contain the same XDATA structure...")))
62.       (setq enx (entget sourceent '("*")))
63.       (setq ss (SS_SSgetXD (list (assoc 0 enx) '(60 . 0) (assoc 410 enx)) (mapcar 'xdfunc (cdr (assoc -3 enx))) 0 (mapcar 'car (cdr (assoc -3 enx))) )))
64.     )
65.     (progn
66.       (setq blk "T62-04 Reviziono okno - poklopac kruzni"))
67.       (repeat (setq i (sslength ss))
68.         (setq pt (ssname ss (setq i (1- i))))
69.         (vl-cmdf "_.INSERT" blk "_S" razmera "_R" 0.0 "_none" (vl-some '(lambda ( x ) (if (and (= (type x) 'list) (< 1 (length x) 4)) x)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 1000)) (apply 'append (mapcar 'cdr (cdr (assoc -3 (entget pt '("*")))))))))) )
70.       )
71.     )
72.   )
73.   (princ)
74. )
75.  

P.S. Provided code was not tested - there may be typos, but essence is there... Feel free to mod. it to suit your needs...

Stay well and healthy...
HTH. M.R.

[milanp]

Thanks for your reply. I tried the code and it reports an error, but I will try to find out what is important. Thanks again