home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / jul93.zip / TIP883A.LSP < prev    next >
Lisp/Scheme  |  1993-06-21  |  2KB  |  63 lines
  1. ; TIP883A: DDE.LSP (C)1993, Allen S. Johnson
  2. ; Edit Text, Attributes, and Dimensions
  3.  
  4. ;; combined dd editor for blocks, attdefs & text
  5.  
  6. (defun C:DDE (/ SP E)
  7.      (while (not E) (setq E (entsel "Select Object: ")))
  8.      (if E (setq SP (cadr E)
  9.                E  (entget (car E))
  10.           )
  11.      )
  12.      (cond ((member (field 0 E) '("TEXT" "ATTDEF")) (command ".ddedit" SP ""))
  13.           ((and (= (field 0 E) "INSERT") (= (field 66 E) 1)) (command ".ddatte" SP))
  14.           ((= (field 0 E) "DIMENSION")  (ddedim E))
  15.           ( T  (prompt "Not Text, Attdef or Block with Attributes...\n"))
  16.      )
  17. (princ))
  18.  
  19. (defun ddedim (E / DCL_ID DIMTXT EDITXT) 
  20.      (setq DCL_ID (load_dialog "DDE.DCL"))
  21.      (if  (not (new_dialog "DDEDIM" DCL_ID)) (exit))
  22.  
  23.      (if (member (field 0 E) '("DIMENSION"))
  24.           (progn
  25.                (setq DIMTXT "")
  26.                (set_tile "DEFTXT"    (rtos (actual E)))
  27.                (set_tile "USRTXT"          (field 1 E))
  28.                (set_tile (cond  ((= (field 1 E) ""    )    "DEF")
  29.                ( t (mode_tile "USRTXT" 2) "USR")) (itoa 1))     
  30.  
  31.                (action_tile "DEF"    "(setq DIMTXT \"\")" )
  32.                (action_tile "USR"    "(setq DIMTXT (get_tile \"USRTXT\")) (mode_tile \"USRTXT\" 2)"    )
  33.                (action_tile "USRTXT" "(setq EDITXT $value DIMTXT EDITXT)  (set_tile \"USR\" (itoa 1))" )
  34.  
  35.                (if (eq (start_dialog) 1) (echg E 1 DIMTXT))
  36.                (unload_dialog dcl_id)
  37.           )
  38.      )
  39. (princ))
  40.  
  41. (defun ECHG (ENT FLD VAL)
  42. (entmod (subst (cons FLD VAL) (assoc FLD ENT) ENT)))
  43.  
  44. (defun FIELD (VAL E)
  45. (cdr (assoc VAL E)))
  46.  
  47. (defun actual (E / DT DLF SP EP HYP ANG PRO) 
  48.      (setvar "cmdecho" 0)
  49.      (setq SP  (field 13 E) 
  50.           EP  (field 14 e)
  51.           DT  (logand 127 (field 70 E))
  52.           DLF (if (= (field 3 E) "*UNNAMED") 
  53.                (getvar "dimlfac")
  54.                (field 144 (tblsearch "dimstyle" (field 3 E)))
  55.           )
  56.           HYP (distance SP EP)
  57.           ANG (if (= DT 1) 0 (- (angle SP EP) (field 50 E)))
  58.      )
  59.      (abs (* (cos ANG) HYP DLF))              ;returns projected length
  60. ); end dde.lsp
  61.  
  62.  
  63.