home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / IMINSERT.LSP < prev    next >
Text File  |  1989-03-01  |  3KB  |  95 lines
  1. ; IMINSERT V 1.2 for use with INSERT MANAGER
  2. ; COPYRIGHT 1989 CADD Masters
  3. ; ALL RIGHTS RESERVED
  4.  
  5. ; REVISION RECORD:
  6. ; VER 1.2 -     (setvar "snapbase" (setq vc (getvar "viewctr")))
  7. ;                            CHANGED TO:
  8. ; (setvar "snapbase" (list (nth 0 (setq vc (getvar "viewctr"))) (nth 1 vc)))
  9. ; VIEWCTR REL 10 IS 3D
  10.   
  11.                 
  12.  
  13. (defun c:iminsert (/ p1 err acaderr s sldcoords obj tar pt xs ys rot strpos getcoord sld blk ce snpbs snp scl vc vcx vcy pt ptx pty x y coord)
  14.  
  15. (defun err (msg)
  16.   (command "undo" 2)
  17.   (princ (strcat "\nerror:" msg "or invalid and/or null pick.  Please try again."))
  18.   (setq *error* acaderr)
  19.   (prin1)
  20. )
  21.  
  22. (defun strpos (obj tar / lobj ltar pos)
  23.   (setq lobj (strlen obj))
  24.   (setq ltar (strlen tar))
  25.   (setq pos 1)
  26.   (while (and (<= pos ltar) (/= obj (substr tar pos lobj)))
  27.     (setq pos (+ pos 1))
  28.   )
  29.   (if (> pos ltar)
  30.     (setq pos 0)
  31.   )
  32.   pos
  33. )
  34.  
  35.   (setq ce (getvar "cmdecho"))
  36.   (setvar "cmdecho" 0)
  37.   (setq acaderr *error*)
  38.   (setq *error* err)
  39.   (setq sld (strcase (getstring (strcat "\nMatrix file name: <" (getvar "dwgprefix") ">"))))
  40.   (if (/= (setq postn (strpos "." sld)) 0)
  41.     (setq sld (substr sld 1 (- postn 1)))
  42.   )
  43.   (if (and (setq b (open (strcat sld ".DAT") "r")) (setq s (open (strcat sld ".sld") "r")))
  44.   (progn
  45.     (close s)
  46.     (setq snpbs (getvar "snapbase"))
  47.     (setq snp (getvar "snapunit"))
  48.     (setq snpmd (getvar "snapmode"))
  49.     (setvar "snapunit" (list (setq scl (/ (getvar "viewsize") 11.0)) (/ (getvar "viewsize") 11.0)))
  50.     (setvar "snapbase" (list (nth 0 (setq vc (getvar "viewctr"))) (nth 1 vc)))
  51.     (setq vcx (nth 0 vc) vcy (nth 1 vc))
  52.     (setq coord (read-line b))
  53.     (while coord
  54.       (setq blk (read-line b))
  55.       (setq sldcoords (cons (list coord blk) sldcoords))
  56.       (setq coord (read-line b))
  57.     )
  58.     (close b)
  59.     (command "vslide" sld)
  60.     (command "setvar" "snapmode" 1)
  61.     (setq pt (getpoint "Choose (enter to end):"))
  62.     (while pt
  63.       (setq ptx (nth 0 pt) pty (nth 1 pt))
  64.       (setq x (/ (- ptx vcx) scl) y (/ (- pty vcy) scl))
  65.       (setq blk (nth 0 (cdr (assoc (strcat (rtos x 2 1) " " (rtos y 2 1)) sldcoords))))
  66.       (write-line blk)
  67.       (redraw)
  68.       (setvar "snapmode" 0)
  69.       (setvar "orthomode" 1)
  70.       (prompt "\nInsertion point:")
  71.       (command "insert" blk pause 1.0 1.0 0.0)
  72.       (terpri)
  73.       (prompt "\nX scale factor:")
  74.       (command "scale" "last" "" (setq p1 (getvar "lastpoint")) pause)
  75.       (setq xscl (cdr (assoc 41 (entget (entlast)))))
  76.       (terpri)
  77.       (entdel (entlast))
  78.       (setvar "cmdecho" 1)
  79.       (command "insert" blk p1 xscl pause pause)
  80.       (setvar "cmdecho" 0)
  81.       (command "vslide" sld)
  82.       (command "setvar" "snapmode" 1)
  83.       (setq pt (getpoint "Choose (return to end):"))
  84.     )
  85.     (setvar "snapmode" snpmd)
  86.     (setvar "snapunit" snp)
  87.     (setvar "snapbase" snpbs)
  88.     (redraw)
  89.   )
  90.     (prompt (strcat "File(s): " sld ".DAT and/or " sld ".SLD not found!"))
  91.   )
  92.   (setvar "cmdecho" ce)
  93.   (prin1)
  94. )
  95.