home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / apr94cad.zip / DDMOD.LSP < prev    next >
Lisp/Scheme  |  1994-03-11  |  6KB  |  192 lines
  1. ;==========================================================
  2. ; DDMOD.LSP Copyright 1993 by Looking Glass Microproducts
  3. ;==========================================================
  4. ; Adds Attribute Editing to DDMODIFY command. 
  5. ;=============================================================
  6. (defun C:DDMOD (/ ERROR OLD-ERROR NOTRANS ITEM ITEMS COPYAT 
  7.                   ATTUPD ESEL ENAME ENT TENAME TEXTENT SS1)
  8.    ;==========================================================
  9.    ; Error Handler
  10.    (defun ERROR (S)
  11.       (if (not
  12.              (member
  13.                 S
  14.                 '("Function cancelled" "console break")
  15.              )
  16.           )
  17.          (princ S)
  18.       )
  19.       (command "_undo" "_end")
  20.       (princ)
  21.    )
  22.    ;==========================================================
  23.    ; Disallow transparent invocation of routine.
  24.    ;==========================================================
  25.    (defun NOTRANS ()
  26.       (cond
  27.          ((zerop (logand (getvar "cmdactive") (+ 1 2 4 8))))
  28.          ((alert
  29.              "This command may not be invoked transparently."
  30.           )
  31.          )
  32.       )
  33.    )
  34.    ;==========================================================
  35.    ; Item from association list
  36.    ;==========================================================
  37.    (defun ITEM (A B) (cdr (assoc A B)))
  38.    ;==========================================================
  39.    ; Return the enumerated items in alist
  40.    ;==========================================================
  41.    (defun ITEMS (NLIST ALIST / SUBENT BLIST)
  42.       (foreach N (reverse NLIST)
  43.          (if (setq SUBENT (assoc N ALIST))
  44.             (setq
  45.                BLIST (cons SUBENT BLIST)
  46.             )
  47.          )
  48.       )
  49.       BLIST
  50.    )
  51.    ;==========================================================
  52.    ; Copy attribute as a text entity
  53.    ;==========================================================
  54.    (defun COPYAT (ATTENT)
  55.       (setq
  56.          ;-------------------------------------------
  57.          ; vertical flag is group 73 for text and 74 for
  58.          ; attributes
  59.          ATTENT (subst
  60.                    (cons 73 (ITEM 74 ATTENT))
  61.                    (assoc 73 ATTENT)
  62.                    ATTENT
  63.                 )
  64.          ;------------------------------------------
  65.          ; grab the rest
  66.          ATTENT (append
  67.                    '((0 . "TEXT"))
  68.                    (ITEMS
  69.                       '(1   ; Text value
  70.                          6   ; Linetype
  71.                          7   ; Text style
  72.                          8   ; Layer
  73.                          10  ; Insertion point
  74.                          11  ; Alignment point
  75.                          39  ; thickness
  76.                          40  ; height
  77.                          41  ; relative X scale factor
  78.                          50  ; Rotation angle
  79.                          51  ; Obliquing angle
  80.                          62  ; Color
  81.                          67  ; Paper Space Flag
  82.                          71  ; Text generation flags
  83.                          72  ; Horiz. Justification type
  84.                          73  ; Vert. Justification type
  85.                          210 ; Extrusion direction
  86.                       )
  87.                       ATTENT
  88.                    )
  89.                 )
  90.       )
  91.       (entmake ATTENT)
  92.    )
  93.    ;==========================================================
  94.    ; Update attribute from text entity
  95.    ;==========================================================
  96.    (defun ATTUPD (ATTENT TEXTENT)
  97.       (entmod
  98.          (append
  99.             (list
  100.                (assoc -1 ATTENT)           ; entity name
  101.                (assoc 0 ATTENT)            ; ATTRIB
  102.                (assoc 2 ATTENT)            ; tag
  103.                (assoc 70 ATTENT)           ; flags
  104.                (cons 74 (ITEM 73 TEXTENT)) ; vertical just
  105.             )
  106.             (cddr TEXTENT)
  107.          )
  108.       )
  109.    )
  110.    ;==========================================================
  111.    ; Body of c:ddmod  
  112.    ;==========================================================
  113.    (if (NOTRANS)
  114.       (progn
  115.          (setvar "cmdecho" 0)
  116.          (command "_undo" "_group")
  117.          (setq
  118.             OLD-ERROR *error*
  119.             *error*   ERROR
  120.             SS1       (ssget "I")
  121.             ESEL      (if (and SS1 (= 1 (sslength SS1)))
  122.                          (list
  123.                             (ssname SS1 0)
  124.                             '(0 0 0)
  125.                          )
  126.                       )
  127.             SS1       nil
  128.          )
  129.          (cond
  130.             ((and
  131.                 (not DDMODIFY)
  132.                 (princ "\nInitializing...")
  133.                 (not
  134.                    (load "ddmodify" nil)
  135.                 )
  136.              )
  137.                (alert "DDMODIFY.LSP:  Can't load file.")
  138.             )
  139.             ((not
  140.                 (or
  141.                    ESEL
  142.                    (setq
  143.                       ESEL (nentsel
  144.                               "\nSelect object to modify: "
  145.                            )
  146.                    )
  147.                 )
  148.              )
  149.                (princ "\nNothing selected.")
  150.             )
  151.             ((= 4 (length ESEL)) ; entity inside block
  152.                (DDMODIFY (last (last ESEL)))
  153.             )
  154.             ((progn
  155.                 (setq ENAME (car ESEL) ENT (entget ENAME))
  156.                 (= "ATTRIB" (ITEM 0 ENT))
  157.              )
  158.                (COPYAT ENT)
  159.                (setq TENAME (entlast))
  160.                (DDMODIFY TENAME)
  161.                (setq TEXTENT (entget TENAME))
  162.                (ATTUPD ENT TEXTENT)
  163.                (entdel TENAME)
  164.                (entupd ENAME)
  165.             )
  166.             ((= "VERTEX" (ITEM 0 ENT))
  167.                (while (progn
  168.                          (setq
  169.                             ENAME (entnext ENAME)
  170.                             ENT   (entget ENAME)
  171.                          )
  172.                          (/= "SEQEND" (ITEM 0 ENT))
  173.                       )
  174.                )
  175.                (setq ENAME (ITEM -2 ENT))
  176.                (DDMODIFY ENAME)
  177.             )
  178.             (t (DDMODIFY ENAME))
  179.          )
  180.          (command "_undo" "_end")
  181.       )
  182.    )
  183.    (princ)
  184. )
  185. (princ
  186.    (strcat
  187.       "  DDMOD.LSP v1.0 (Copyright 1993 by "
  188.       "Looking Glass Microproducts) loaded."
  189.    )
  190. )
  191. (princ)
  192.