home *** CD-ROM | disk | FTP | other *** search
/ Current Shareware 1994 January / SHAR194.ISO / cad_util / dt100.zip / EDATTRIB.LSP < prev    next >
Lisp/Scheme  |  1993-09-25  |  25KB  |  915 lines
  1. ; DrafTools   [Version 1.00] 9/25/93       
  2. ;
  3. ; ***************************************
  4. ; ****  Author:  Owen Wengerd        ****
  5. ; ****                               ****
  6. ; ****  Manu-Soft Computer Services  ****
  7. ; ****  P.O. Box 84                  ****
  8. ; ****  Fredericksburg, OH  44627    ****
  9. ; ****  (216) 695-5903               ****
  10. ; ****  Compu-Serve ID:  71324,3252  ****
  11. ; ***************************************
  12.  
  13.  
  14. (defun EDATTRIB (entity / 
  15.  
  16. ; *** Local Variables ***
  17.  
  18.   dcl_id         
  19.   dlg_retcode    
  20.   entlist        
  21.   errflag 
  22.   just_def_list  
  23.   last_focus     
  24.   old_entlist    
  25.   olderr         
  26.   oldvar         
  27.   restore
  28.   style_list
  29.   t1             
  30.   t2             
  31.   
  32.  
  33. ; *** Local Functions ***  
  34.   
  35.   errexit        
  36.   edattribx          
  37.   EDATTRIB           
  38.   ap_set             
  39.   check_layer        
  40.   check_ltype        
  41.   clear_err          
  42.   color_name         
  43.   compare_name       
  44.   dismiss_dialog     
  45.   dlg_act            
  46.   ent_edit           
  47.   err                
  48.   find_idx           
  49.   fpath              
  50.   get_color          
  51.   get_help           
  52.   get_layer          
  53.   get_ltype          
  54.   get_table          
  55.   ip_set             
  56.   parse_path         
  57.   rtd
  58.   sort_list          
  59.   sort_search        
  60.   update_color       
  61.   update_dlg         
  62.   valid_name         
  63.   )
  64.  
  65.  
  66. ;*****************  Function Definitions  ******************
  67.  
  68. (defun errexit (s)
  69.   (princ "\nError:  ")
  70.   (princ s)
  71.   (restore)
  72. )
  73.  
  74. (defun edattribx ()
  75.   (setvar "ATTMODE" (nth 1 oldvar))
  76.   (setvar "ATTREQ" (nth 2 oldvar))
  77.   (setvar "REGENMODE" (nth 3 oldvar))
  78.   (setvar "EXPERT" (nth 4 oldvar))
  79.   (setvar "CMDECHO" (car oldvar))
  80.   (command "_UCS" "_P")
  81.   (setq *error* olderr)
  82. )
  83.  
  84. (defun rtd (a) (/ (* a 180.0) pi))
  85.  
  86. (defun dlg_act (key why value / t1)
  87.   (cond
  88.     ( (= key "invisible")
  89.       (ent_edit 
  90.         (if (= "0" value)  
  91.           (logand 254 (cdr (assoc '70 entlist)))  
  92.           (logior 1 (cdr (assoc '70 entlist)))
  93.         )
  94.         '70
  95.       )
  96.     )
  97.     ( (= key "constant")
  98.       (ent_edit 
  99.         (if (= "0" value)  
  100.           (logand 253 (cdr (assoc '70 entlist)))  
  101.           (logior 2 (cdr (assoc '70 entlist)))
  102.         )
  103.         '70
  104.       )
  105.     )
  106.     ( (= key "verify")
  107.       (ent_edit 
  108.         (if (= "0" value)  
  109.           (logand 251 (cdr (assoc '70 entlist)))  
  110.           (logior 4 (cdr (assoc '70 entlist)))
  111.         )
  112.         '70
  113.       )
  114.     )
  115.     ( (= key "preset")
  116.       (ent_edit 
  117.         (if (= "0" value)  
  118.           (logand 247 (cdr (assoc '70 entlist)))  
  119.           (logior 8 (cdr (assoc '70 entlist)))
  120.         )
  121.         '70
  122.       )
  123.     )
  124.     ( (= key "upside_down")
  125.       (ent_edit 
  126.         (if (= "0" value)  
  127.           (logand 251 (cdr (assoc '71 entlist)))  
  128.           (logior 4 (cdr (assoc '71 entlist)))
  129.         )
  130.         '71
  131.       )
  132.     )
  133.     ( (= key "backward")
  134.       (ent_edit 
  135.         (if (= "0" value)  
  136.           (logand 253 (cdr (assoc '71 entlist)))  
  137.           (logior 2 (cdr (assoc '71 entlist)))
  138.         )
  139.         '71
  140.       )
  141.     )
  142.     ( (= key "update_style")
  143.       (ent_edit 
  144.         (cdr 
  145.           (assoc '70 (setq t1 (nth (atoi (get_tile "style")) style_list)))
  146.         )  
  147.         '70
  148.       )
  149.       (ent_edit 
  150.         (if (= '0 (setq t2 (cdr (assoc '40 t1)))) (cdr (assoc '42 t1)) t2)  
  151.         '40
  152.       )
  153.       (ent_edit (cdr (assoc '41 t1)) '41)
  154.       (ent_edit (cdr (assoc '50 t1)) '51)
  155.       (if 
  156.         (or 
  157.           (not errflag)
  158.           (member errflag 
  159.             '("height" "width" "oblique" "upside_down" "backward")
  160.           )
  161.         )
  162.         (progn
  163.           (if errflag (mode_tile errflag 2) (mode_tile last_focus 2))
  164.           (update_dlg entlist)
  165.           (clear_err)
  166.         )
  167.         (progn
  168.           (setq t1 (get_tile errflag))
  169.           (update_dlg entlist)
  170.           (set_tile errflag t1)
  171.           (mode_tile errflag 2)
  172.         )
  173.       )
  174.     )
  175.     ( (and errflag (/= errflag key))  
  176.     )
  177.     ( (= key "thickness")    
  178.       (if (numberp (setq t1 (distof value)))
  179.         (progn
  180.           (clear_err)
  181.           (ent_edit t1 '39)
  182.           (set_tile key (rtos t1))
  183.         )
  184.         (err "Thickness must be a real number." key)
  185.       )
  186.     )
  187.     ( (= key "height")    
  188.       (if (and (numberp (setq t1 (distof value))) (> t1 0))
  189.         (progn
  190.           (clear_err)
  191.           (ent_edit t1 '40)
  192.           (set_tile key (rtos t1))
  193.         )
  194.         (err "Height must be positive and non-zero." key)
  195.       )
  196.     )
  197.     ( (= key "width")    
  198.       (if (and (numberp (setq t1 (distof value))) (> t1 0))
  199.         (progn
  200.           (clear_err)
  201.           (ent_edit t1 '41)
  202.           (set_tile key (rtos t1))
  203.         )
  204.         (err "Width Factor must be positive and non-zero." key)
  205.       )
  206.     )
  207.     ( (= key "oblique")    
  208.       (if (setq t1 (angtof (get_tile key)))
  209.         (progn
  210.           (clear_err)
  211.           (ent_edit t1 '51)
  212.           (set_tile key (angtos t1))
  213.         )
  214.         (err "Oblique angle must be a valid angle." key)
  215.       )
  216.     )
  217.     ( (= key "rotation")    
  218.       (if (setq t1 (angtof (get_tile key)))
  219.         (progn
  220.           (clear_err)
  221.           (ent_edit t1 '50)
  222.           (set_tile key (angtos t1))
  223.         )
  224.         (err "Rotation angle must be a valid angle." key)
  225.       )
  226.     )
  227.     ( (= key "tag")
  228.       (ent_edit value '2)
  229.       (set_tile key (strcase value))
  230.     )
  231.     ( (= key "prompt")
  232.       (ent_edit value '3)
  233.     )
  234.     ( (= key "default")
  235.       (ent_edit value '1)
  236.     )
  237.     ( (member key '("x_ip" "y_ip" "z_ip"))
  238.       (if (numberp (setq t1 (distof value)))
  239.         (progn
  240.           (clear_err)
  241.           (ent_edit
  242.             (subst
  243.               t1
  244.               (nth (- (ascii key) 120) (setq t2 (cdr (assoc '10 entlist))))
  245.               t2
  246.             )
  247.             '10
  248.           )
  249.           (set_tile key (rtos t1))
  250.         )
  251.         (err 
  252.           (strcat 
  253.             "Insertion Point "
  254.             (chr (- (ascii key) 32))  
  255.             "-Coordinate must be a real number."
  256.           )
  257.           key
  258.         )
  259.       )
  260.     )
  261.     ( (member key '("x_ap" "y_ap" "z_ap"))
  262.       (if (numberp (setq t1 (distof value)))
  263.         (progn
  264.           (clear_err)
  265.           (ent_edit
  266.             (subst
  267.               t1
  268.               (nth (- (ascii key) 120) (setq t2 (cdr (assoc '11 entlist))))
  269.               t2
  270.             )
  271.             '11
  272.           )
  273.           (set_tile key (rtos t1))
  274.         )
  275.         (err 
  276.           (strcat 
  277.             "Alignment Point "
  278.             (chr (- (ascii key) 32))  
  279.             "-Coordinate must be a real number."
  280.           )
  281.           key
  282.         )
  283.       )
  284.     )
  285.     ( (= key "style")
  286.       (ent_edit (cdr (assoc '2 (setq t1 (nth (atoi value) style_list)))) '7)
  287.     )
  288.     ( (= key "justify")
  289.       (ent_edit
  290.         (car (nth (atoi value) just_def_list))
  291.         '72
  292.       )  
  293.       (ent_edit
  294.         (cadr (nth (atoi value) just_def_list))
  295.         '74
  296.       )  
  297.       (update_dlg entlist)
  298.     )
  299.   )
  300.   (if errflag (mode_tile errflag 2) (setq last_focus key))
  301. )
  302.  
  303. (defun clear_err ()
  304.   (set_tile "error" "")
  305.   (setq errflag nil)
  306.   (mode_tile "accept" 0)
  307.   (mode_tile "preview" 0)
  308. )
  309.  
  310. (defun err (msg key)
  311.   (mode_tile "accept" 1)
  312.   (mode_tile "preview" 1)
  313.   (set_tile "error" msg)
  314.   (setq errflag key)
  315. )      
  316.  
  317. (defun ent_edit (newvalue grp)
  318.   (setq entlist
  319.     (if (assoc grp entlist)
  320.       (subst (cons grp newvalue) (assoc grp entlist) entlist)
  321.       (append entlist (list (cons grp newvalue)))
  322.     )
  323.   )
  324. )
  325.  
  326. (defun update_dlg (el / t1)
  327.   (set_tile "current_layer" (cdr (assoc '8 el)))
  328.   (set_tile "handle" (if (setq t1 (cdr (assoc '5 el))) t1 ""))
  329.   (set_tile "thickness" (rtos (if (setq t1 (cdr (assoc '39 el))) t1 0.0)))
  330.   (set_tile "current_linetype"
  331.     (if (setq t1 (cdr (assoc '6 el))) t1 "BYLAYER")
  332.   )
  333.   (update_color el)
  334.   (set_tile "default" (if (setq t1 (cdr (assoc '1 el))) t1 ""))
  335.   (set_tile "prompt" (if (setq t1 (cdr (assoc '3 el))) t1 ""))
  336.   (set_tile "tag" (if (setq t1 (cdr (assoc '2 el))) t1 ""))
  337.   (setq t1 (if (setq t1 (cdr (assoc '70 el))) t1 '0))  
  338.   (set_tile "invisible" (itoa (logand 1 t1)))                  
  339.   (set_tile "constant" (itoa (logand 1 (lsh t1 -1))))
  340.   (set_tile "verify" (itoa (logand 1 (lsh t1 -2))))
  341.   (set_tile "preset" (itoa (logand 1 (lsh t1 -3))))
  342.   (setq t1 (if (setq t1 (cdr (assoc '71 el))) t1 '0))
  343.   (set_tile "backward" (itoa (logand 1 (lsh t1 -1))))
  344.   (set_tile "upside_down" (itoa (logand 1 (lsh t1 -2))))
  345.   (set_tile "rotation" (angtos (if (setq t1 (cdr (assoc '50 el))) t1 '0)))
  346.   (set_tile "height" (rtos (if (setq t1 (cdr (assoc '40 el))) t1 '0)))
  347.   (set_tile "width" (rtos (if (setq t1 (cdr (assoc '41 el))) t1 '0)))
  348.   (set_tile "oblique" (angtos (if (setq t1 (cdr (assoc '51 el))) t1 '0)))
  349.   (set_tile "style"  
  350.     (itoa         
  351.       (find_idx (if (setq t1 (cdr (assoc '7 el))) t1 "STANDARD") style_list)
  352.     )                  
  353.   )
  354.   (setq t1 (if (setq t1 (cdr (assoc '10 el))) (append t1 '(0)) '(0 0 0)))
  355.   (set_tile "x_ip" (rtos (car t1)))
  356.   (set_tile "y_ip" (rtos (cadr t1)))
  357.   (set_tile "z_ip" (rtos (caddr t1)))
  358.   (setq t1 (if (setq t1 (cdr (assoc '11 el))) (append t1 '(0)) '(0 0 0)))
  359.   (set_tile "x_ap" (rtos (car t1)))
  360.   (set_tile "y_ap" (rtos (cadr t1)))
  361.   (set_tile "z_ap" (rtos (caddr t1)))
  362.   (set_tile "justify"  
  363.     (itoa 
  364.       (- 15 
  365.         (length 
  366.           (member 
  367.             (list (cdr (assoc '72 el)) (cdr (assoc '74 el)))  
  368.             just_def_list
  369.           )
  370.         )    
  371.       )
  372.     )
  373.   )
  374.   (cond 
  375.     ( (= 3 (setq t1 (cdr (assoc '72 el))))  
  376.       (mode_tile "rotation" 1)
  377.       (mode_tile "digitize_angle" 1)
  378.       (mode_tile "height" 1)
  379.       (ap_set '0)
  380.       (ip_set '0)
  381.     )
  382.     ( (= 5 t1)
  383.       (mode_tile "rotation" 1)
  384.       (mode_tile "digitize_angle" 1)
  385.       (mode_tile "height" 0)
  386.       (ap_set '0)
  387.       (ip_set '0)
  388.     )
  389.     ( (if 
  390.         (progn
  391.           (mode_tile "rotation" 0)
  392.           (mode_tile "digitize_angle" 0)
  393.           (mode_tile "height" 0)
  394.           (/= 0 (logior t1 (cdr (assoc '74 el))))  
  395.         )
  396.         T 
  397.         (progn (ap_set '1) (ip_set '0) nil)
  398.       )
  399.       (ip_set '1)
  400.       (ap_set '0)
  401.     )
  402.   )
  403. )
  404.  
  405. (defun ap_set (set / t1)
  406.   (foreach t1 '("x_ap" "y_ap" "z_ap" "pick_ap") (mode_tile t1 set))
  407. )
  408.  
  409. (defun ip_set (set / t1)
  410.   (foreach t1 '("x_ip" "y_ip" "z_ip" "pick_ip") (mode_tile t1 set))
  411. )
  412.  
  413. (defun find_idx (name lst / cnt)
  414.   (setq cnt (1- (length lst)))
  415.   (while 
  416.     (and (>= cnt 0) (/= name (cdr (assoc '2 (nth cnt lst)))))  
  417.     (setq cnt (1- cnt))
  418.   )
  419.   (if (< cnt 0) nil cnt)
  420. )
  421.  
  422. (defun color_name (color / t1)
  423.   (if (= 256 color)
  424.     "BYLAYER"
  425.     (if
  426.       (setq t1 (nth color '("BYBLOCK"  "RED"      "YELLOW"   "GREEN"    "CYAN"    
  427.                             "BLUE"     "MAGENTA"  "WHITE"    "BLACK"
  428.                            )
  429.                )
  430.       )
  431.       t1
  432.       ""
  433.     )
  434.   )
  435. )
  436.  
  437. (defun update_color (el)
  438.   (set_tile "current_color"
  439.     (if (setq t1 (cdr (assoc '62 el))) (color_name t1) "BYLAYER")
  440.   )                    
  441.   (start_image "color_image")
  442.   (fill_image 
  443.     0 0 
  444.     (dimx_tile "color_image") (dimy_tile "color_image")
  445.     (if 
  446.       (and t1 (/= t1 256))  
  447.       t1 
  448.       (abs (cdr (assoc '62 (tblsearch "LAYER" (cdr (assoc '8 el))))))
  449.     )
  450.   )
  451.   (end_image)
  452. )
  453.  
  454. (defun compare_name (x y) (> (cdr (assoc '2 x)) (cdr (assoc '2 y))))
  455.  
  456. (defun sort_search (/ track)
  457.   (mapcar '(lambda (x) (if (and x (sfunc x track)) (setq track x))) lst)
  458.   (setq lst (subst nil track lst))
  459.   track
  460. )
  461.  
  462. (defun sort_list (lst sfunc / tlst)
  463.   (while 
  464.     (apply 'or lst)  
  465.     (setq tlst (append tlst (list (sort_search))))
  466.   )
  467.   tlst
  468. )
  469.  
  470. (defun get_table (table / t1 t2)
  471.   (while (setq t1 (tblnext table (not t1))) (setq t2 (append t2 (list t1))))
  472.   t2
  473. )
  474.  
  475. (defun fpath (filename / path)
  476.   (if 
  477.     (and
  478.       *DT_PATH 
  479.       (setq path
  480.         (findfile 
  481.           (strcat 
  482.             *DT_PATH 
  483.             (if (= "\\" (substr *DT_PATH (strlen *DT_PATH) 1)) "" "\\")  
  484.             filename
  485.           )
  486.         )
  487.       )
  488.     )
  489.     path
  490.     (findfile filename)
  491.   )
  492. )
  493.  
  494. (defun get_help (/ help_path)
  495.   (if (setq help_path (fpath "EDATTRIB.HLP"))
  496.     (acad_helpdlg help_path "")
  497.     (alert "Cannot locate help file 'EDATTRIB.HLP'!")
  498.   )
  499.   (mode_tile (if errflag errflag last_focus) 2)
  500. )
  501.  
  502. (defun parse_path (name / ct)
  503.   (setq ct (strlen name))
  504.   (while (and (> ct 0) (/= "\\" (substr name ct 1))) (setq ct (1- ct)))
  505.   (if (> ct 0) (setq name (substr name ct)) name)
  506. )
  507.  
  508. (defun valid_name (name)
  509.   (not (wcmatch name "*[] `#`@`.`?`*`~`[`,`'!%^&()+={}|`\\:;\"<>/]*"))
  510. )
  511.  
  512. (defun check_ltype (/ t1)
  513.   (if 
  514.     (and 
  515.       (/= "" (setq t1 (strcase (get_tile "ltype"))))  
  516.       (member t1 ltype_names)
  517.     )
  518.     (progn
  519.       (setq cltype t1)
  520.       (done_dialog 1)
  521.     )
  522.     (progn
  523.       (set_tile "error"  
  524.         (if (= t1 "")
  525.           "Press <Cancel> or specify a linetype."
  526.           "Select an existing layer name."
  527.         )
  528.       )
  529.       (mode_tile "ltype" 2)
  530.     )
  531.   )
  532. )
  533.  
  534. (defun get_ltype (eltype / ltype_list ltype_names cltype t1)
  535.   (if errflag
  536.     (mode_tile errflag 2)
  537.     (if (new_dialog "LTYPE" dcl_id)
  538.       (progn
  539.         (setq ltype_list 
  540.           (reverse (sort_list (get_table "LTYPE") compare_name))
  541.         )
  542.         (start_list "existing")
  543.         (mapcar 'add_list 
  544.           (setq ltype_names
  545.             (append
  546.               '("BYLAYER" "BYBLOCK")
  547.               (mapcar '(lambda (x) (cdr (assoc '2 x))) ltype_list)
  548.             )
  549.           )
  550.         )
  551.         (end_list)
  552.         (set_tile "existing"  
  553.           (itoa (- (length ltype_names) (length (member eltype ltype_names))))
  554.         )
  555.         (set_tile "ltype" eltype)
  556.         (action_tile "accept" "(check_ltype)")
  557.         (action_tile "cancel" "(done_dialog 0)")
  558.         (action_tile "existing"  
  559.           (strcat
  560.             "(and"
  561.               " (set_tile \"ltype\" (nth (atoi $value) ltype_names))"
  562.               " (= 4 $reason)"
  563.               " (check_ltype)"
  564.             ")"
  565.           )
  566.         )
  567.         (set_tile "ltype" (if (setq t1 (cdr (assoc '6 entlist))) t1 "BYLAYER"))
  568.         (if (= 1 (start_dialog))  
  569.           (progn 
  570.             (ent_edit cltype '6)
  571.             (set_tile "current_linetype" cltype)
  572.           )
  573.         )
  574.       )
  575.       (set_tile "error" "Child Dialog Box 'LTYPE' Cannot Initialize")
  576.     )
  577.   )
  578. )
  579.  
  580. (defun check_layer (/ t1)
  581.   (if (and (/= "" (setq t1 (strcase (get_tile "layer")))) (valid_name t1))
  582.     (progn
  583.       (setq clayer t1)
  584.       (done_dialog 1)
  585.     )
  586.     (progn
  587.       (set_tile "error"  
  588.         (if (= t1 "")
  589.           "Press <Cancel> or specify a layer name."
  590.           "Layer name contains invalid characters."
  591.         )
  592.       )
  593.       (mode_tile "layer" 2)
  594.     )
  595.   )
  596. )
  597.  
  598. (defun get_layer (elayer / layer_list layer_names clayer t1)
  599.   (if errflag
  600.     (mode_tile errflag 2)
  601.     (if (new_dialog "LAYER" dcl_id)
  602.       (progn
  603.         (setq layer_list 
  604.           (reverse (sort_list (get_table "LAYER") compare_name))
  605.         )
  606.         (start_list "existing")
  607.         (mapcar 'add_list 
  608.           (setq layer_names
  609.             (mapcar '(lambda (x) (cdr (assoc '2 x))) layer_list)
  610.           )
  611.         )
  612.         (end_list)
  613.         (set_tile "existing"  
  614.           (itoa (- (length layer_names) (length (member elayer layer_names))))
  615.         )
  616.         (set_tile "layer" elayer)
  617.         (action_tile "accept" "(check_layer)")
  618.         (action_tile "cancel" "(done_dialog 0)")
  619.         (action_tile "existing"  
  620.           (strcat
  621.             "(and"
  622.               " (set_tile \"layer\" (nth (atoi $value) layer_names))"
  623.               " (= 4 $reason)"
  624.               " (check_layer)"
  625.             ")"
  626.           )
  627.         )
  628.         (set_tile "layer" (cdr (assoc '8 entlist)))
  629.         (if (= 1 (start_dialog))  
  630.           (progn 
  631.             (ent_edit clayer '8)
  632.             (set_tile "current_layer" clayer)
  633.             (update_color entlist)
  634.           )
  635.         )
  636.       )
  637.       (set_tile "error" "Child Dialog Box 'LAYER' Cannot Initialize")
  638.     )
  639.   )
  640. )
  641.  
  642. (defun get_color (/ t1)
  643.   (if errflag
  644.     (mode_tile errflag 2)
  645.     (progn
  646.       (ent_edit
  647.         (acad_colordlg (if (setq t1 (cdr (assoc '62 entlist))) t1 '256))
  648.         '62
  649.       )
  650.       (update_color entlist)
  651.     )
  652.   )
  653. )
  654.  
  655. (defun dismiss_dialog (retcode)
  656.   (if 
  657.     (and
  658.      errflag 
  659.       (not (and (= retcode 3) (wcmatch errflag "?_ip")))
  660.       (not (and (= retcode 4) (wcmatch errflag "?_ap")))
  661.       (not (and (= retcode 5) (= errflag "rotation")))
  662.     )
  663.     (mode_tile errflag 2)  
  664.     (progn
  665.       (if errflag 
  666.         (progn (setq last_focus errflag) (clear_err))
  667.       )
  668.       (done_dialog retcode)
  669.     )
  670.   )
  671. )
  672.  
  673. ;*********************************************************
  674. ;*******************  MAIN PROGRAM  **********************
  675. ;*********************************************************
  676.  
  677.   (setq T (not nil))
  678.   (if 
  679.     (and 
  680.       (setq dcl_id (if (setq t1 (fpath "EDATTRIB.DCL")) (load_dialog t1)))
  681.       (entlast)
  682.       (= "ATTDEF"  
  683.         (cdr 
  684.           (assoc 
  685.             '0 
  686.             (entget 
  687.               (if entity 
  688.                 entity
  689.                 (setq entity
  690.                   (if
  691.                     (setq t1 
  692.                       (entsel 
  693.                         "\n \nSelect an Attribute Definition to Edit:  "
  694.                       )
  695.                     )
  696.                     (car t1)
  697.                     (entlast)
  698.                   )
  699.                 )
  700.               )
  701.             )
  702.           )  
  703.         )
  704.       )
  705.     )  
  706.     (progn
  707.       (setq oldvar
  708.         (list
  709.           (getvar "CMDECHO")
  710.           (getvar "ATTMODE")
  711.           (getvar "ATTREQ")
  712.           (getvar "REGENMODE")
  713.           (getvar "EXPERT")
  714.         )
  715.       )
  716.       (setq olderr   *error*
  717.             restore  edattribx
  718.             *error*  errexit
  719.       )
  720.       (setvar "CMDECHO" 0)
  721.       (setvar "REGENMODE" 1)
  722.       (setvar "EXPERT" 0)
  723.       (setvar "ATTDIA" 1)
  724.       (setvar "ATTMODE" 0)
  725.       (setvar "ATTREQ" 0)
  726.       (terpri)
  727.       (command "_UCS" "_W")
  728.       (setq dlg_retcode   6
  729.             old_entlist   (entget entity)
  730.             last_focus    "default"
  731.             just_def_list (list '(0 0)
  732.                                 '(1 0)  
  733.                                 '(2 0)
  734.                                 '(3 0)
  735.                                 '(4 0)
  736.                                 '(5 0)
  737.                                 '(0 2)
  738.                                 '(1 2)
  739.                                 '(2 2)
  740.                                 '(0 3)
  741.                                 '(1 3)
  742.                                 '(2 3)
  743.                                 '(0 1)
  744.                                 '(1 1)
  745.                                 '(2 1)
  746.                           )
  747.       )          
  748.       (while (and (> dlg_retcode 1) (new_dialog "ATTEDIT" dcl_id))
  749.         (start_list "justify")
  750.         (foreach t1
  751.           (list
  752.             "Left"           "Center"          "Right"
  753.             "Aligned"        "Middle"          "Fit"
  754.             "Middle Left"    "Middle Center"   "Middle Right"
  755.             "Top Left"       "Top Center"      "Top Right"
  756.             "Bottom Left"    "Bottom Center"   "Bottom Right"
  757.           )
  758.           (add_list t1)
  759.         )
  760.         (end_list)
  761.         (start_list "style")
  762.         (foreach t1 
  763.           (setq style_list 
  764.             (reverse (sort_list (get_table "STYLE") compare_name))
  765.           )
  766.           (add_list (cdr (assoc '2 t1)))
  767.         )
  768.         (end_list)
  769.         (update_dlg (setq entlist (entget entity)))
  770.         (action_tile "help" "(get_help)")
  771.         (action_tile "preview" "(dismiss_dialog 2)")
  772.         (action_tile "pick_ip" "(dismiss_dialog 3)")
  773.         (action_tile "pick_ap" "(dismiss_dialog 4)")
  774.         (action_tile "digitize_angle" "(dismiss_dialog 5)")
  775.         (action_tile "color" "(get_color)")
  776.         (action_tile "layer" "(get_layer (get_tile \"current_layer\"))")
  777.         (action_tile "linetype"  
  778.           "(get_ltype (get_tile \"current_linetype\"))"
  779.         )
  780.         (action_tile "accept" "(done_dialog 1)")
  781.         (action_tile "cancel" "(done_dialog 0)")
  782.         (foreach t1
  783.           '("invisible"      "constant"      "verify"          "preset"
  784.             "thickness"      "tag"           "prompt"          "default"
  785.             "justify"        "style"         "height"          "width"
  786.             "oblique"        "upside_down"   "backward"        "rotation"
  787.             "update_style"   "x_ip"          "y_ip"            "z_ip"          
  788.             "x_ap"           "y_ap"          "z_ap"
  789.           )
  790.           (action_tile t1 "(dlg_act $key $reason $value)")
  791.         )
  792.         (if last_focus (mode_tile last_focus 2))
  793.         (setq dlg_retcode (start_dialog))
  794.         (cond
  795.           ( (= 0 dlg_retcode) (entmod old_entlist))
  796.           (
  797.             (= 2 dlg_retcode)
  798.             (entmod entlist)      
  799.             (prompt "\nPress any key to continue\n")
  800.             (grread)
  801.             (grread 1)
  802.             (redraw)
  803.             (princ "\nReturning to Dialog Box\n \n ")
  804.           )
  805.           (
  806.             (= 3 dlg_retcode)
  807.             (entmod entlist)
  808.             (prompt "\nPick the Attribute Insertion Point:  ")
  809.             (setq t1 (cdr (assoc '10 entlist)))
  810.             (command 
  811.               cancel
  812.               cancel
  813.               "_MOVE"
  814.               entity
  815.               ""
  816.               t1
  817.               pause
  818.             )
  819.             (princ "\nInsertion Point Selected\n \n ")
  820.           )
  821.           (
  822.             (= 4 dlg_retcode)
  823.             (entmod entlist)
  824.             (setq t1 (cdr (assoc '11 entlist)))
  825.             (if 
  826.               (or 
  827.                 (= 3 (setq t2 (cdr (assoc '72 entlist))))  
  828.                 (= 5 t2)
  829.                 (and (= 0 t2) (= 0 (cdr (assoc '74 entlist))))
  830.               )
  831.               (setq entlist
  832.                 (entmod 
  833.                   (subst 
  834.                     (cons '11 
  835.                       (getpoint 
  836.                         "\nPick the Alignment Point:  "
  837.                         (cdr (assoc '11 entlist))
  838.                       )
  839.                     )
  840.                     (assoc '11 entlist)
  841.                     entlist
  842.                   )
  843.                 )
  844.               )      
  845.               (command 
  846.                 cancel
  847.                 cancel
  848.                 "_MOVE"
  849.                 entity
  850.                 ""
  851.                 t1         
  852.                 pause
  853.               )
  854.             )      
  855.             (princ "\nAlignment Point Selected\n \n ")
  856.           )
  857.           (
  858.             (= 5 dlg_retcode)
  859.             (entmod entlist)
  860.             (setq t2 (if (setq t2 (cdr (assoc '50 entlist))) t2 '0))
  861.             (prompt "\nPick the Attribute Rotation Angle:  ")
  862.             (setq t1 
  863.               (cdr 
  864.                 (assoc 
  865.                   (if 
  866.                     (or 
  867.                       (= 3 (setq t1 (cdr (assoc '72 entlist))))
  868.                       (= 5 t1)
  869.                       (and (= 0 t1)  (= 0 (cdr (assoc '74 entlist))))
  870.                     )
  871.                     '10 
  872.                     '11
  873.                   )
  874.                   entlist
  875.                 )
  876.               )
  877.             )
  878.             (command 
  879.               cancel
  880.               cancel
  881.               "_ROTATE"
  882.               entity
  883.               ""
  884.               t1
  885.               "_R"
  886.               (rtd t2)
  887.               pause
  888.             )
  889.             (princ "\nRotation Angle Selected\n \n ")
  890.           )
  891.           (T (entmod entlist))
  892.         )
  893.       )
  894.       (unload_dialog dcl_id)
  895.       (restore)
  896.     )
  897.     (alert 
  898.       (cond 
  899.         ( (not dcl_id)
  900.           (strcat 
  901.             "Dialog Box Definition File 'EDATTRIB.DCL' not Found"
  902.             "\n                Cannot Continue!"
  903.           )
  904.         )
  905.         ((entlast) "Selected Entity Must Be An Attribute Definition!")
  906.         (T "There are no entities to edit!")
  907.       )
  908.     )
  909.   )
  910.   dlg_retcode
  911. )
  912.  
  913.  
  914.  
  915.