home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_ATTE.LSP < prev    next >
Lisp/Scheme  |  1996-09-30  |  7KB  |  179 lines
  1. ;;; FLX_ATTE.LSP
  2. ;;; ====================================================================
  3. ;;; Provided for FelixCAD
  4. ;;; ====================================================================
  5. ;;; defun ATTVALUE in flx_main.lsp
  6. ;;; ====================================================================
  7.  
  8. (defun FLX_ATTQEDIT ( / TEDIT_INIT lang prt_list el1 el2 ep1 p1 p2 w1 w2 
  9.                         s1 fl e1 mod1 mod2 a_tag a_flag t_value t_angle 
  10.                         tmp_cmdecho)
  11.    
  12.     (FLX_FUNC_INIT) ;;; Error Handler
  13.  
  14.     ;;; Prompt list
  15.  
  16.     (setq prt_list (list
  17.          "Select attribute of part: " ;1
  18.          "Insertion point: " ; not used ;2
  19.          "No attribute selected !" ;3
  20.          "Modify Attribute Value" ;4
  21.          "No entity in drawing !"
  22.          "Alert"
  23.          "Target point: " ;6
  24.          "New angle" ;7
  25.          "Move" ; 8
  26.          "Rotate" ; 9
  27.     ))
  28.     (if FLX_XLANGUAGE (FLX_XLANGUAGE "_atte" "_attqedit"))
  29.   
  30.     ;;; Dialog initialization
  31.  
  32.     (defun TEDIT_INIT( / n)
  33.       (foreach n 
  34.           '("IDOK"  "IDCANCEL" "Edit1"  "Static1" "Check1" "Check2")
  35.            (Dlg_TileSetFont n 2)
  36.       )
  37.       (Dlg_TileSet  "Static1" a_tag)
  38.       (Dlg_TileSet  "Edit1" t_value)
  39.       (Dlg_TileMode "Edit1" 2)  
  40.       (Dlg_TileAction "Check1" "(setq mod1 (if (= $value \"1\") T nil))")  ;;; Move
  41.       (Dlg_TileAction "Check2" "(setq mod2 (if (= $value \"1\") T nil))")  ;;; Rotate
  42.       (Dlg_TileAction "Edit1"  "(setq s1 (Dlg_TileGet \"Edit1\"))")
  43.       (Dlg_TileAction "IDOK" "(setq s1 (Dlg_TileGet \"Edit1\"))(Dlg_DialogDone)")
  44.       (Dlg_TileAction "IDCANCEL" "(setq s1 nil)(Dlg_DialogDone)")
  45.    )
  46.  
  47.    ;;; Main
  48.    
  49.    (if (entlast)
  50.      (progn
  51.         (while (not ep1)
  52.            (initget 256 (strcat (nth 8 prt_list) " " (nth 9 prt_list))) ;;; "Move" "Rotate"
  53.            (setq ep1 (nentsel (nth 0 prt_list)))  ;;;@Select attribute of part: 
  54.            (cond 
  55.               ((= ep1 (nth 8 prt_list) ) (setq mod1 T ep1 nil)) ;; Move
  56.               ((= ep1 (nth 9 prt_list) ) (setq mod2 T ep1 nil)) ;; Rotate
  57.            )
  58.         )
  59.         (setq f1 nil e1 (car ep1) el1 (entget e1))
  60.         (if (= (cdr (assoc 0 el1)) "ATTRIB")
  61.                (progn
  62.                   (setq
  63.                       t_value (cdr (assoc 1 el1))   ;;; Attribute Value
  64.                       a_tag   (cdr (assoc 2 el1))   ;;; Attribute Tag
  65.                       a_flag  (cdr (assoc 70 el1))  ;;; Attribute Flag
  66.                       t_angle (angtos (cdr (assoc 50 el1)) 0 -1)
  67.                   )
  68.                   (if (or mod1 mod2)
  69.                      (setq s1 nil)
  70.                      (progn
  71.                        (setq mod1 nil mod2 nil)
  72.                        (if (FLX_DLGDSP "flx_dlg" "ATTQEDIT" "(princ)" "(TEDIT_INIT)") (princ) (exit))
  73.                      )
  74.                   )
  75.                   (if S1 (progn
  76.                       (setq el2 (subst (cons 1 s1) (assoc 1 el1) el1))
  77.                       (if el2 (progn
  78.                          (entmod el2)
  79.                          (entupd (setq e2 (car (last ep1))))
  80.                          (redraw e2 1)
  81.                       ))
  82.                   ))
  83.                   (if MOD1 (progn
  84.                       (setq f1 nil e1 (car ep1) el1 (entget e1))
  85.                       (setq p1 (cdr (assoc 10 el1)))
  86.                       (setq p2 (getpoint p1 (nth 6 prt_list)))
  87.                       (if (not p2) (setq p2 p1))
  88.                       (setq el2 (subst (cons 10 p2) (assoc 10 el1) el1))
  89.                       (if el2 (progn
  90.                          (entmod el2)
  91.                          (entupd (setq e2 (car (last ep1))))
  92.                          (redraw e2 1)
  93.                       ))
  94.                    ))
  95.                    (if MOD2 (progn
  96.                       (setq f1 nil e1 (car ep1) el1 (entget e1))
  97.                       (setq p1 (cdr (assoc 10 el1))  w1 (cdr (assoc 50 el1)))
  98.                       (setq w2 (getangle p1 (strcat (nth 7 prt_list) " <" (angtos w1 0 -1) ">: ")))
  99.                       (if (not w2) (setq w2 w1))
  100.                       (setq el2 (subst (cons 50 w2) (assoc 50 el1) el1))
  101.                       (if el2 (progn
  102.                          (entmod el2)
  103.                          (entupd (setq e2 (car (last ep1))))
  104.                          (redraw e2 1)
  105.                       ))
  106.                    ))
  107.               )
  108.               (alert
  109.                 (nth 2 prt_list)  ;;;@No attribute selected !
  110.                 (nth 3 prt_list)  ;;;@Modify Attribute Value
  111.                 "EXCLAMATION"
  112.               )
  113.          )  ;;; if attrib
  114.       )
  115.       (alert
  116.         (nth 4 prt_list)  ;;;@No entity in drawing !
  117.         (nth 5 prt_list)  ;;;@Alert
  118.         "EXCLAMATION"
  119.       ) 
  120.     ) ;; if entlast
  121.     (FLX_FUNC_EXIT) (setq *error* nil)
  122.     (princ)
  123. )
  124.  
  125. ;;; Move attribute
  126.  
  127. (defun FLX_ATTMOVE ( / prt_list ep1 p1 e1 el1 p2 el2 e2) 
  128.     (defun *error* (msg) (setq *error* nil) (princ))
  129.     (setq prt_list (list
  130.         "Select attribute of part: " 
  131.         "Target point: "
  132.     ))
  133.     (if FLX_XLANGUAGE (FLX_XLANGUAGE "_atte" "_attmove"))
  134.     (setq ep1 (nentsel (nth 0 prt_list))) ;;;@Select attribute of part: 
  135.     (setq p1 (cdr ep1) e1 (car ep1) el1 (entget e1))
  136.     (if (= (cdr (assoc 0 el1)) "ATTRIB") (progn
  137.       (setq p1 (cdr (assoc 10 el1)))
  138.       (setq p2 (getpoint p1 (nth 1 prt_list))) ;;;@Target point: 
  139.       (if (not p2) (setq p2 p1))
  140.       (setq el2 (subst (cons 10 p2) (assoc 10 el1) el1))
  141.       (entmod el2)
  142.       (entupd (setq e2 (car (last ep1))))
  143.       (redraw e2 1)
  144.     ))
  145.     (setq *error* nil) 
  146.     (princ)
  147. )
  148.  
  149. ;;; Rotate attribute
  150.  
  151. (defun FLX_ATTROT( / ep1 p1 e1 el1 p2 el2 e2 w1 w2) 
  152.     (defun *error* (msg) (setq *error* nil) (princ))
  153.     (setq prt_list (list
  154.         "Select attribute of part: " 
  155.         "New angle <"
  156.     ))
  157.     (if FLX_XLANGUAGE (FLX_XLANGUAGE "_atte" "_attrot"))
  158.     (setq ep1 (nentsel (nth 0 prt_list))) ;;;@Select attribute of part: 
  159.     (setq p1 (cdr ep1) e1 (car ep1) el1 (entget e1))
  160.     (if (= (cdr (assoc 0 el1)) "ATTRIB") (progn
  161.       (setq p1 (cdr (assoc 10 el1)) w1 (cdr (assoc 50 el1)))
  162.       (setq w2 (getangle p1 (strcat 
  163.          (nth 1 prt_list)        ;;;@New angle <
  164.          (angtos w1 0 -1)
  165.          ">: "
  166.       )))
  167.       (if (not w2) (setq w2 w1))
  168.       (setq el2 (subst (cons 50 w2) (assoc 50 el1) el1))
  169.       (entmod el2)
  170.       (entupd (setq e2 (car (last ep1))))
  171.       (redraw e2 1)
  172.     ))
  173.     (setq *error* nil) 
  174.     (princ)
  175. )
  176.  
  177. (princ)
  178.  
  179.