;;; - ------------------------------------------------------------------------------ - ;
;;; -                T O O L - A C M  - I N S E R T S E L E C T                      - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung : Auswahl von Blockreferenzen in Abhängigkeit von Blockname       - ;
;;; -                Attributname und Attributwert                                   - ;
;;; - Befehle      : INSERTSELECT                                                    - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 20.06.2024                                                - ;
;;; -              durch : Thomas Krüger                                             - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun C:INSERTSELECT (/ BLOCKNAMEFILTER TAGSTRINGFILTER VALUEFILTER INSERTS AWS
                         BLOCKSEARCH BLOCKSEARCHDLG DLGRETURN
                      )
  (defun INSERTSELECT(BLOCKNAMEFILTER TAGSTRINGFILTER VALUEFILTER / INSERTS)
    (if(and(or(and(=(type BLOCKNAMEFILTER) 'LIST)
                  (setq BLOCKNAMEFILTER
                         (vl-remove-if-not'(lambda(X)(=(type X)'STR))BLOCKNAMEFILTER)
                  )
                  (setq BLOCKNAMEFILTER
                         (vl-string-right-trim ","
                           (apply 'strcat (mapcar
                                            '(lambda(X)(strcat X ","))
                                            BLOCKNAMEFILTER
                                          )
                           )
                         )
                  )
                  (/= BLOCKNAMEFILTER "")
              )
              (setq BLOCKNAMEFILTER "*")
           )
           (or(and(=(type TAGSTRINGFILTER) 'LIST)
                  (setq TAGSTRINGFILTER
                         (vl-remove-if-not'(lambda(X)(=(type X)'STR))TAGSTRINGFILTER)
                  )
                  (setq TAGSTRINGFILTER
                         (vl-string-right-trim ","
                           (apply 'strcat (mapcar
                                            '(lambda(X)(strcat X ","))
                                            TAGSTRINGFILTER
                                          )
                           )
                         )
                  )
                  ;(/= TAGSTRINGFILTER "")
              )
              (and(= TAGSTRINGFILTER "")(= VALUEFILTER "")) ;;
              (setq TAGSTRINGFILTER "*")
           )
           (or(and(=(type VALUEFILTER) 'LIST)
                  (setq VALUEFILTER
                         (vl-remove-if-not'(lambda(X)(=(type X)'STR))VALUEFILTER)
                  )
                  (setq VALUEFILTER
                         (vl-string-right-trim ","
                           (apply 'strcat (mapcar
                                            '(lambda(X)(strcat X ","))
                                            VALUEFILTER
                                          )
                           )
                         )
                  )
                  ;(/= VALUEFILTER "")
              )
              (and(= TAGSTRINGFILTER "")(= VALUEFILTER ""))
              (setq VALUEFILTER "*")
           )
           (or(setq INSERTS (ssget "_x" (list '(0 . "INSERT")(cons 410 (getvar "CTAB")))))
              (prompt"\nKeine Blockreferenzen im aktuellen Layout gefunden")
           )
           (setq INSERTS(mapcar
                         '(lambda(X / ITEM ATTRIBUTES ATTRIBUT FOUND)
                            (if(and(setq ITEM(vlax-ename->vla-object (cadr X)))
                                   (member(strcase(vla-get-objectname  ITEM))
                                          '("ACDBBLOCKREFERENCE" "ACDBMINSERTBLOCK")
                                   )
                                   (or(and(vlax-property-available-p ITEM "IsDynamicBlock")
  		                          (=(vla-get-IsDynamicBlock ITEM):vlax-true)
  		                          (setq BLOCKNAME (vla-get-effectivename ITEM))
                                      )    
                                      (setq BLOCKNAME (vla-get-Name ITEM))
                                   )
                                   (=(type  BLOCKNAME) 'STR)
                                   (wcmatch (strcase BLOCKNAME)(strcase BLOCKNAMEFILTER))
                                )
                               (cond
                                  ((and(= TAGSTRINGFILTER "")(= VALUEFILTER "")) ITEM);_Blöcke ohne Attribute
                                  ((and(=(vla-get-hasattributes ITEM) :vlax-true)     ;_Blöcke mit Attributen
                                       (setq ATTRIBUTES (vlax-variant-value(vla-getattributes ITEM)))
                                       (=(vlax-safearray-get-dim ATTRIBUTES)1)
                                       (<=(vlax-safearray-get-l-bound ATTRIBUTES 1)
                                          (vlax-safearray-get-u-bound ATTRIBUTES 1)
                                       )
                                   )
                                     (foreach ATTRIBUT (vlax-safearray->list ATTRIBUTES)
                                       (if(and(=(type(setq TAGSTRING(vla-get-Tagstring ATTRIBUT)))'STR) 
                                              (wcmatch (strcase TAGSTRING)(strcase TAGSTRINGFILTER))
                                              (=(type(setq TEXTSTRING(vla-get-Textstring ATTRIBUT)))'STR)
                                              (wcmatch (strcase TEXTSTRING)(strcase VALUEFILTER))
                                          )
                                         (setq FOUND 'T)
                                       )
                                     )
                                     (if FOUND ITEM)
                                  )
                               )
                            )
                          )
                          (ssnamex INSERTS)
                       )
           )
           (setq INSERTS(vl-remove-if 'null INSERTS))
       )
      INSERTS
    )
  )
  (defun GETATTINFO(ATTRIB / TAGSTRING DOC OWNER BLOCKNAME TEXTSTRING)
    (if(and(setq ATTRIB(cond               
                         ((=(type ATTRIB) 'VLA-object)ATTRIB)
                         ((=(type ATTRIB) 'Ename)(vlax-ename->vla-object ATTRIB))
                       )
           )
           (=(strcase(vla-get-objectname ATTRIB)) "ACDBATTRIBUTE")
           (setq TAGSTRING  (vla-get-TAGSTRING  ATTRIB))
           (setq TEXTSTRING (vla-get-Textstring ATTRIB))
           (setq DOC  (vla-get-document ATTRIB))             	 
           (setq OWNER(cond
                        ((and(>(vl-string-search "x64" (getvar "PLATFORM"))0)
			     (vlax-method-applicable-p  (vla-get-Document ATTRIB) "ObjectIdToObject32")
                             (vlax-property-available-p ATTRIB "ownerid32")
                         )
                          (vlax-invoke-method
                            (vla-get-Document ATTRIB)'ObjectIdToObject32
                            (vla-get-ownerid32 ATTRIB)
                          )
                        )                     
                        ('T
                          (vlax-invoke-method
                            (vla-get-Document ATTRIB)'ObjectIdToObject
                            (vla-get-ownerid ATTRIB)
                          )
                        )
                      )  
           )           
           (or(and(vlax-property-available-p OWNER "IsDynamicBlock")
  		(=(vla-get-IsDynamicBlock OWNER):vlax-true)
  		(setq BLOCKNAME (vla-get-effectivename OWNER))
              )    
              (setq BLOCKNAME (vla-get-Name OWNER))
           )
       )
      (list BLOCKNAME TAGSTRING TEXTSTRING)
    )
  )
  (defun INSERTSELECTDLG ( / WRITE-DCL DLG-CHECK DLG-RUN BLKNAME ATTNAME ATTWERT)
    (defun WRITE-DCL(/ DIR POS FILE)
      (if(and(setq DIR(vl-filename-mktemp (strcat "INSERTSELECTDLG.DCL")))
             (setq FILE (open DIR "w"))
         )
        (progn
          (mapcar
             '(lambda (X)
                (princ (strcat X "\n") FILE)
              )
            '(
                ""
                "INSERTSELECT"
                ": dialog"
                "{  key = DLGTITEL;   "         
                "   : row   "
                "   {"
                "     : boxed_column"
                "     { width = 60;"
                "       fixed_width = true;"
                "           : button"
                "           { label = \"Vorgabeattribut wählen..\";"
                "             key   = \"OBJEKT\";"
                "             fixed_width = true;"
                "             width = 59;"
                "             alignment = right;"
                "           }"
                "       : row "
                "       {  height = 1;"
                "          fixed_height = true;"
                "          alignment = centered;"              
                "         : column"
                "         { width = 28;"
                "           fixed_width = true;"
                "           : text"
                "           { "
                "             key   = \"TEXT1\";"
                "             label = \"Filter Blockname\";"
                "             alignment = left;"
                "           }"
                "           : text"
                "           { "
                "             key   = \"TEXT2\";"
                "             label = \"Filter Attributsname\";"
                "             alignment = left;"
                "           }"
                "           : text"
                "           { "
                "             key   = \"TEXT3\";"
                "             label = \"Filter Attributswert\";"
                "             alignment = left;"
                "           }"
                "         }"
                "         : column"
                "         { width = 27;"
                "           fixed_width = true;"
                "           : edit_box"
                "           { label       = \"\";"
                "             key         = \"BLKNAME\";"
                "             width       = 25;"
                "             fixed_width = true;"
                "             height      = 1;"
                "             fixed_height= true;"
                "             alignment   = left;"
                "           }"                                                         
                "           : edit_box"
                "           { label       = \"\";"
                "             key         = \"ATTNAME\";"
                "             width       = 25;"
                "             fixed_width = true;"
                "             height      = 1;"
                "             fixed_height= true;"
                "             alignment   = left;"
                "           }"                                
                "           : edit_box"
                "           { label       = \"\";"
                "             key         = \"ATTWERT\";"
                "             width       = 25;"
                "             fixed_width = true;"
                "             height      = 1;"
                "             fixed_height= true;"
                "             alignment   = left;"
                "           }"       
                "         }"             
                "       }"
                "       : row "
                "       {"
                "          height = 1;"
                "          fixed_height = true;"
                "       } "                
                "     }"
                "   }"                
                "  : row"
                "  {"
                "    "
                "    : button"
                "    { label = \"OK\";"
                "      key   = \"OK\";"
                "      fixed_width = true;"
                "      width = 19;"
                "      alignment = right;"
                "      mnemonic =\"O\";"
                "    }"
                "    : cancel_button"
                "    { label = \"Abbruch\";"
                "      key = \"CANCEL\";"
                "      fixed_width = true;"
                "      width = 19;"
                "      alignment = right;"
                "      mnemonic =\"A\"; "
                "      is_cancel = true;"
                "    }"
                "    : button"
                "    { label = \"Info\";"
                "      key   = \"INFO\";"
                "      fixed_width = true;"
                "      width = 19;"
                "      alignment = right;"
                "      mnemonic =\"I\";"
                "    }"
                "    "
                "  }  "
                "}"
                ""
              )
           )
           (close FILE)
           DIR
         )
       )
    )
    (defun DLG-CHECK()
      (or(/=(setq BLKNAME(get_tile  "BLKNAME"))"")(setq BLKNAME "*"))
      (setq ATTNAME(get_tile  "ATTNAME"))
      (setq ATTWERT(get_tile  "ATTWERT"))
      (list BLKNAME ATTNAME ATTWERT)
    )        
    (defun DLG-RUN(DIR / DLGINDEX EXIT? NR BLKNAME ATTNAME ATTWERT)
      (setq BLKNAME "*" ATTNAME "*" ATTWERT "*")
      (while (not EXIT?)
        (if(>(setq DLGINDEX (load_dialog DIR))0)
          (if(new_dialog "INSERTSELECT" DLGINDEX)
            (progn            
              (set_tile  "DLGTITEL" "ACM-INSERTSELECT © Th.Krüger 2024 ")
              (set_tile  "BLKNAME"  BLKNAME)
              (set_tile  "ATTNAME"  ATTNAME)
              (set_tile  "ATTWERT"  ATTWERT)
              (action_tile "OBJEKT"       "(done_dialog 5)")
              (action_tile "OK"           (strcat
                                            "(setq RETURN(DLG-CHECK))"
                                            "(done_dialog 1)"                                          
                                          )  
              )
              (action_tile "CANCEL"       "(setq RETURN            nil)(done_dialog 0)")
              (action_tile "INFO"         "(alert(strcat \"=========== ACMINSERTSELECT  ==========\n\n\"
                                                         \"          Blockreferenzauswahl bezüglich Blocknamen,\n\"
                                                         \"                  Attributnamen und Attributwert\n\n\"
                                                         \"\t\t© Th.Krüger 2024     \n\"
                                                         \"\t\t  tk@cad-od.de\n\"
                                                 )
                                           )"      
              )                                    
              (setq EXIT? (start_dialog)) 
              (cond         
                ((= EXIT? 5)  
                  (if(and(not(vl-catch-all-error-p
                               (setq DUMMY(vl-catch-all-apply
                                            'nentsel (list "\nAttribut wählen : ")
                                          )
                               )      
                             )
                         )
                         (setq DUMMY(car DUMMY))
                         (setq DUMMY(GETATTINFO DUMMY))                                      
                     )                      
                    (progn
                      (list BLOCKNAME TAGSTRING TEXTSTRING)
                      (if(=(type(car   DUMMY))'STR)(setq BLKNAME  (car   DUMMY))(setq BLKNAME  "*"))
                      (if(=(type(cadr  DUMMY))'STR)(setq ATTNAME  (cadr  DUMMY))(setq ATTNAME  "*"))
                      (if(=(type(caddr DUMMY))'STR)(setq ATTWERT  (caddr DUMMY))(setq ATTWERT  "*"))
                    )   
                    (alert "Kein Attribut gewählt!")
                  )
                  (setq EXIT? nil)   
                )
                ('T(setq EXIT? 'T))      
              )                    
              (unload_dialog DLGINDEX)
            )
            (progn (alert "Fehler bei der Dialoginitialisierung")(setq EXIT? 'T))
          )
          (progn (alert "Dialog nicht gefunden")(setq EXIT? 'T))
        )  
      )    
      RETURN
    )
    (if(and(setq DCLFILE(WRITE-DCL))(setq DCLFILE(findfile DCLFILE)))       
      (progn
        (setq RETURN(DLG-RUN DCLFILE))       
        (vl-file-delete DCLFILE)
        RETURN
      )
    )  
  )
  
  (if (=(getvar "CMDDIA")1)
    (if(and(setq DLGRETURN(INSERTSELECTDLG))
           (or(=(type(setq BLOCKNAMEFILTER(car   DLGRETURN)))'STR)(setq BLOCKNAMEFILTER "*"))
           (or(=(type(setq TAGSTRINGFILTER(cadr  DLGRETURN)))'STR)(setq TAGSTRINGFILTER "*"))
           (or(=(type(setq VALUEFILTER    (caddr DLGRETURN)))'STR)(setq VALUEFILTER "*"))
       )
      (setq INSERTS(INSERTSELECT (list BLOCKNAMEFILTER)(list TAGSTRINGFILTER)(list VALUEFILTER)))    
    )  
    (if(and(or(and(=(type(setq BLOCKNAMEFILTER (getstring "\nBLOCKNAME <\"*\"> :")))'STR)
                  (/= BLOCKNAMEFILTER "")
              )
              (setq BLOCKNAMEFILTER "*")
           )
           (or(=(type(setq TAGSTRINGFILTER (getstring "\nATTRIBUTNAME <\"*\"> :")))'STR)
              (setq TAGSTRINGFILTER "*")
           )
           (or(=(type(setq VALUEFILTER (getstring "\nATTRIBUTWERT <\"*\"> :")))'STR)
              (setq VALUEFILTER "*")
           )
       )    
      (setq INSERTS(INSERTSELECT (list BLOCKNAMEFILTER)(list TAGSTRINGFILTER)(list VALUEFILTER)))
    )
  )
  (if INSERTS
    (progn
       (setq AWS (ssadd))
       (mapcar '(lambda(X / Y) (if(setq Y(vlax-vla-object->ename X))(ssadd Y AWS))) INSERTS)
       (sssetfirst AWS AWS)
    )
    (progn
      (sssetfirst nil nil)
      (prompt "\nKeine Blockreferenzen entsprechend Auswahlkriterien gefunden.")
    )
  )
  (princ)
)  
;;; - ------------------------------------------------------------------------------- - ;
(defun ACM-INSERTSELECT:INFO() 
  (mapcar
    'princ
    (list
      "\n\n"
      "\nACM-INSERTSELECT :  Auswahl von Blockreferenzen in Abhängigkeit von "
      "\n==================  Blockname Attributname und Attributwert"  
      "\n(C) Thomas Krüger 2024(tk@cad-od.de)"    
      "\nBefehlszeilenaufruf : INSERTSELECT\n"
      "\n"    
    )
  )
  (princ)  
)
;;; - ------------------------------------------------------------------------------- - ;
(ACM-INSERTSELECT:INFO)
(princ)