Symbol Picker

Dear All,

 
;----------Program Written By Aarya & Aastha-------------
(prompt "Symbol Picker")
(defun C:sym (/ id ok sslist symlst SList1 SList2 SNlist symNam NamLst)
 (setq id (load_dialog "symtable.dcl"))
 (setq ok 2)
 (if (new_dialog "sym_table" id)
   (progn 
     (mode_tile "P3" 1)
     (while (> ok 1)
       (action_tile "P2" "(setq symlst (choose $value))")
       (action_tile "list1" "(setq sslist $value ok (done_dialog 2))")
       (action_tile "P3" "(done_dialog 3)")
       (action_tile "accept" "(done_dialog)")
       (action_tile "cancel" "(done_dialog 1)")
       (setq ok (start_dialog))
       (setq symNam (car symlst) NamLst (cadr symlst))
       (if NamLst
  (cond
    ( (= ok 3)
             (setq SList1 (select symNam))
      (new_dialog "sym_table" id)
      (set_tile "P2" symNam)
      (tilemode symNam)
      (additems "list1" NamLst)
      (setq sslist (N2S SList1 NamLst))
      (set_tile "list1" sslist)
      (setq slist2 nil)
    )
    ( (= ok 2)
      (setq SNlist (S2L sslist))
      (setq SList2 (mapcar (function (lambda (x) (nth x NamLst))) SNlist))
      (new_dialog "sym_table" id)
      (set_tile "P2" symNam)
      (tilemode symNam)
      (additems "list1" NamLst)
      (set_tile "list1" sslist)
      (setq slist1 nil)
    )
    ( (= ok 1)
      (setq slist1 nil slist2 nil)
    )
  )
       )
     )
   )
 )
 (unload_dialog id)
 (princ "\n")
 (if slist1 slist1 slist2)
)
;;----------
(defun judge (Name)
 (if (or (member Name slist) (member (strcase Name) slist))
   slist
   (cons Name slist)
 )
)
(defun judge1 (n Nlist / name)
 (setq Name (cdr (assoc n Nlist)))
 (judge Name)
)
;;;-----------
(defun select (sym / ss i l ename elist layer eType slist Llist LName)
 (setq SList nil)
 (if (setq ss (ssget))
   (progn 
     (setq l (sslength ss))
     (setq i 0)
     (repeat l
       (setq ename (ssname ss i))
       (setq elist (entget ename))
(setq eType (cdr (assoc 0 elist)))
       (cond
         ( (= sym "LAYER")
    (setq layer (cdr (assoc 8 elist)))
           (setq slist (judge layer)))
         ( (= sym "LTYPE")
           (if (and (setq ltype (cdr (assoc 6 elist))) (/= ltype "ByBlock"))
      (setq slist (judge ltype))
      (setq layer (cdr (assoc 8 elist))
     LName (tblobjname "LAYER" layer)
            Llist (entget LName)
     slist (judge1 6 Llist))))
         ( (= sym "STYLE")
           (if (or (= eType "TEXT") (= eType "MTEXT"))
      (setq slist (judge1 7 elist))))
         ( (= sym "DIMSTYLE")
           (if (= eType "DIMENSION")
      (setq DName (cdr (assoc 3 elist))
            slist (judge1 3 elist))))
         ( (= sym "BLOCK")
           (if (= eType "INSERT")
             (setq slist (judge1 2 elist))))
       )        
       (setq i (1+ i))
     )
   )
 )
 (setq slist slist)
)
;;;-----------
(defun tblname (tblsym / n1 name namlst)
 (setq namlst nil)
 (if (setq n1 (cdr (assoc 2 (tblnext tblsym T))))
   (progn 
     (setq namlst (cons n1 namlst))
     (while (setq name (cdr (assoc 2 (tblnext tblsym))))
       (setq namlst (cons name namlst))
     )
     (reverse namlst)
   )
 )
)
;;;----------------------
(defun additems (listbox items)
 (start_list listbox)
 (mapcar 'add_list items)
 (end_list)
)
;;;---------------------------
(defun tilemode (s)
 (if (or (= s "UCS") (= s "VIEW") (= s "VPORT") (= s "APPID"))
   (mode_tile "P3" 1)
   (mode_tile "P3" 0)
 )
)
;;;-----------------
(defun choose (pp / namelist)
 (tilemode pp)
 (if (setq namelist (tblname pp))
   (additems "list1" namelist)
   (progn
     (start_list "list1")
     (end_list)
     (setq sslist nil)
   )
 )
 (list pp namelist)
)
;;;-----------------------
(defun S2L (cval)
 (if cval
   (read (strcat "(" cval ")"))
 )
)
;;;-------------------------------
(defun N2S (NList NamLst)
 (L2S (mapcar (function (lambda (x) (my-position x NamLst))) NList))
)
(defun N2S1 (NList NamLst);;-----------
 (L2S (mapcar (function (lambda (x) (vl-position x NamLst))) NList))
)
;;;---------------------
(defun L2S (lst / s)
 (setq s (apply 'strcat (mapcar (function (lambda(x) (strcat (itoa x) " "))) lst)))
 (substr s 1 (1- (strlen s)))
)
(defun my-position (n mylist / new ifm len)
 (setq new (strcase n))
 (setq ifm (member n mylist))
 (setq len (length (if ifm ifm (member new mylist))))
 (if (> len 0)
   (- (length mylist) len)
 )
)

Dcl Code

//symTable.dcl
sym_table : dialog {
  label = "Symbol Picker";
  : row {
    key = "P1";
    : boxed_radio_column {
      key = "P2";
      label = "Symbol Type";
      fixed_width = true;
      : radio_button {
        key = "LAYER";
        label = "LAYER";
      }
      : radio_button {
        key = "LTYPE";
        label = "LTYPE";
      }
      : radio_button {
        key = "VIEW";
        label = "VIEW";
      }
      : radio_button {
        key = "STYLE";
        label = "STYLE";
      }
      : radio_button {
        key = "BLOCK";
        label = "BLOCK";
      }
      : radio_button {
        key = "VPORT";
        label = "VPORT";
      }
      : radio_button {
        key = "APPID";
        label = "APPID";
      }
      : radio_button {
        key = "UCS";
        label = "UCS";   
      }
      : radio_button {
        key = "DIMSTYLE";
        label = "DIMSTYLE";
      }
      spacer;
    }
    : list_box {
      key = "list1";
      label = "---------------Name LIst---------------";
      width = 44;
      height = 24;
      multiple_select = true;
    }
  }
  : button {
    key = "P3";
    label = "Pick Object(P)";
    fixed_width = true;
    alignment = centered;
    width = 1;
  }
  ok_cancel;
}

Hmm...what does it do?

Hmm...what does it do?

Dear Sir,

enter the command: SYM, and then select the name of the symbol table, you can check, you can select the graphics. Then return to choose a name for the list, if the cancellation or the empty set, returns an empty set.

Just for autolisp study (learning) project

Dear Sir,

enter the command: SYM, and then select the name of the symbol table, you can check, you can select the graphics. Then return to choose a name for the list, if the cancellation or the empty set, returns an empty set.

 

Just for autolisp study project

So...you don't want feedback on it?

And it's ma'am to you! :wink: