Share Gallery 1/share_gal_1.zip/share_gal_1/GR/GR506.ZIP/ACAD2.EXE/IMDEFINE.V12

Text File | 1989-02-16 | 6KB | 174 lines

; IMDEFINE V 1.2 for use with INSERT MANAGER
; COPYRIGHT 1989 CADD Masters
; ALL RIGHTS RESERVED
;
; Revision record:
; V1.2 - Layer "M" and "F" employed instead of (grclear) because Mslide
; does a redraw before making the slide and any underlying entities will
; appear.

(defun c:imdefine (/ err acaderr blkdata resterr counter pos ce e obj tar fil d ansr f sld blknm ptx pty insx insy ptxless1 ptxplus1 ptyless1 ptyplus1 tmp strpos getdir)

(defun err (msg)
  (command "undo" "e")
  (command "undo" "b")
  (setq *error* acaderr)
  (princ (strcat "error:" msg))
  (prin1)
)

(defun strpos (obj tar / lobj ltar pos)
  (setq lobj (strlen obj))
  (setq ltar (strlen tar))
  (setq pos 1)
  (while (and (<= pos ltar) (/= obj (substr tar pos lobj)))
    (setq pos (+ pos 1))
  )
  (if (> pos ltar)
    (setq pos 0)
  )
  pos
)

(defun getdir (fil / dr)
  (setq dr (substr fil 1 (setq j (strlen fil))))
  (while (and (/= (substr dr j 1) "\\") (>= j 1))
    (setq j (- j 1))
  )
  (if (not (and (= j 1) (= (substr dr j 1) "\\")))
    (setq dr (substr fil 1 j))
    (setq dr "")
  )
  dr
)

  (setq ce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq acaderr *error*)
  (setq *error* err)
  (setq sld (strcase (getstring (strcat "\nMatrix file name (enter to abort): <" (getvar "dwgprefix") ">"))))
  (if (/= sld "")
  (progn
    (command "undo" "m")
    (if (/= (setq postn (strpos "." sld)) 0)
      (setq sld (substr sld 1 (- postn 1)))
    )
    (if (setq f (open (strcat sld ".DAT") "r"))
    (progn
      (close f)
      (setq ansr (strcase (getstring (strcat "\nFile: " sld " exists!  Overwrite? (Y/N): <N>"))))
      (if (/= ansr "Y")
        (setq ansr "N")
      )
    )
    )
    (if (or (not f) (= ansr "Y"))
    (progn
      (setvar "dragmode" 2)
      (setvar "pdmode" 3)
      (setvar "pdsize" 0.5)
      (command "layer" "m" "insertmanagerdefinitionlayer" "c" "white" "" "f" "*" "")
      (command "zoom" "c" (list 0.0 0.0) 11.0)
      (command "color" "red")
      (setq ptx -5.0 pty 4.0)
      (write-line "\nBEGIN SLIDE DEFINITION:")
      (setq d (getvar "dwgprefix"))
      (while (>= pty -4.0)
        (while (<= ptx 5.0)
          (setq blknm (strcase (getstring (strcat "\nInsert file name (enter/Undo/?): <" d ">"))))
          (cond
            ((= blknm "")
              (setq ptx 7.0)
              (setq pty -4.0)
            )
            ((= blknm "?")
              (command "sh" (strcat "dir " d "*.dwg/w"))
              (terpri)
              (getstring "Strike enter to continue . . .")
              (graphscr)
            )
            ((or (= blknm "U") (= blknm "UNDO"))
              (if (and (<= ptx -5.0) (>= pty 4.0))
              (progn
                (setq ptx 7.0)
                (setq pty -4.0)
              )
              (progn
                (if (<= ptx -5.0)
                (progn
                  (setq ptx 5.0)
                  (setq pty (+ pty 2.0))
                )
                  (setq ptx (- ptx 2.0))
                )
                (entdel (entlast))
                (entdel (entlast))
                (entdel (entlast))
                (setq blkdata (cddr blkdata))
              )
              )

            )
            (t
              (if (/= (setq postn (strpos "." blknm)) 0)
                (setq blknm (substr blknm 1 (- postn 1)))
              )
              (if (= (strpos "\\" blknm) 0)
                (setq blknm (strcat d blknm))
                (setq d (getdir blknm))
              )
              (if (setq tmp (open (strcat blknm ".DWG") "r"))
              (progn
                (close tmp)
        (setq blkdata (cons (strcat (rtos ptx 2 1) " " (rtos pty 2 1)) blkdata))
                (setq blkdata (cons blknm blkdata))
                (command "pline" (list (setq ptxless1 (- ptx 1.0)) (setq ptyless1 (- pty 1.0))) (list (setq ptxplus1 (+ ptx 1.0)) ptyless1) (list ptxplus1 (setq ptyplus1 (+ pty 1.0))) (list ptxless1 ptyplus1) "c")
                (redraw (setq hlbox (entlast)) 3)
                (prompt "\nInsertion point:")
                (command "insert" blknm pause 1.0 1.0 0.0)
                (setq insx (nth 0 (getvar "lastpoint")))
                (setq insy (nth 1 (getvar "lastpoint")))
                (terpri)
                (while (or (< insx ptxless1) (< insy ptyless1) (> insx ptxplus1) (> insy ptyplus1))
                  (entdel (entlast))
                  (prompt "\nerror: insertion point must be within highlighted lines.")
                  (prompt "\nInsertion point:")
                  (command "insert" blknm pause 1.0 1.0 0.0)
                  (setq insx (nth 0 (getvar "lastpoint")))
                  (setq insy (nth 1 (getvar "lastpoint")))
                  (terpri)
                )
                (prompt "\nX scale factor:")
        (command "scale" "last" "" (list insx insy) pause)
                (terpri)
                (command "point" (list insx insy))
                (setq ptx (+ ptx 2.0))
                (redraw hlbox 4)
              )
                (write-line (strcat "\nERROR: " blknm ".DWG not found."))
              )
            )
          )
        )
        (setq ptx -5.0)
        (setq pty (- pty 2.0))
      )
      (if blkdata
      (progn
    (setq f (open (strcat sld ".DAT") "w"))
        (command "mslide" sld)
        (setq blkdata (reverse blkdata))
        (foreach n blkdata (write-line n f))
        (close f)
      )
      )
    )
    )
    (command "undo" "e")
    (command "undo" "b")
  )
  )
  (setvar "cmdecho" ce)
  (prin1)
)