[编程交流] 插入并分解块lisp

(defun c:textblock ()
(COMMAND "_layer" "_m" "text" "_c" "140" "" "")
(setq scl (getvar "useri1"))
(setq scl1 (* scl 1.5))
(setq dt1 (getpoint "\ninsert text block: "))
(command" "*insert" "textblock" dt1 scl1 scl1 "0" )
(princ)
)

(defun c:dstamp ()
(COMMAND "_layer" "_m" "dstamp" "_c" "140" "" "")
(setq scl (getvar "useri1"))
(setq scl1 (* scl 1.5))
(setq dt1 (getpoint "\ninsert dstamp: "))
(command"insert" "dstamp" dt1 scl1 scl1 "0" )
(princ)
)

(defun c:textblock ( / DT1 SCL SCL1)
(COMMAND "_layer" "_m" "text" "_c" "140" "" "")
(setq scl (getvar "useri1"))
(setq scl1 (* scl 1.5))
(setq dt1 (getpoint "\ninsert text block: "))
(command "insert" "*textblock" dt1 scl1 "0" )
(princ)
)
(defun c:dstamp ( / DT1 SCL SCL1)
(COMMAND "_layer" "_m" "dstamp" "_c" "140" "" "")
(setq scl (getvar "useri1"))
(setq scl1 (* scl 1.5))
(setq dt1 (getpoint "\ninsert dstamp: "))
(command "insert" "*dstamp" dt1 scl1 "0"
 "_.explode" "_L"
 "_.explode" "_L")
(princ)
)

(defun c:dstamp ( / DT1 SCL SCL1)
(COMMAND "_layer" "_m" "dstamp" "_c" "140" "" "")
(setq scl (getvar "useri1"))
(setq scl1 (* scl 1.5))
(setq dt1 (getpoint "\ninsert dstamp: "))
(command "insert" "dstamp" dt1 scl1 scl1 "0")
(command "_.explode" "_L")
(initcommandversion)
(command "_.explode" "_P" "")
(initcommandversion)
(command "_.explode" "_P" "")
(princ)
)

(defun c:dstamp ( / DT1 SCL SCL1 SS *error* qf)
 (defun *error* ( msg )
   (and qf (setvar 'QAFLAGS qf))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
(COMMAND "_layer" "_m" "dstamp" "_c" "140" "" "")
(setq scl (getvar "useri1"))
(setq scl1 (* scl 1.5))
(setq dt1 (getpoint "\ninsert dstamp: "))
(mip:mark)  
(command "_-insert" "*dstamp" dt1 scl1 scl1)
(if (setq SS (mip:get-last-ss))
 (progn
     (setq qf (getvar 'QAFLAGS))
     (setvar 'QAFLAGS 5)
     (command "_.explode" ss "")
     (setvar 'QAFLAGS qf)
   )
)
 
)
;;;* Mark data base to allow KB:catch.
;;;* http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark ( )
(if (setq *mip:mark (entlast)) nil
   (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
      (setq *mip:mark (entlast))(entdel *mip:mark)))(princ))
;;;* returns selection set of entities since last mip:mark.
(defun mip:get-last-ss (/ ss tmp val)
 (setq val (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (if *mip:mark
   (progn (setq ss (ssadd))
          (while (setq *mip:mark (entnext *mip:mark))
            (ssadd *mip:mark ss)
          ) ;_ end of while
          (if (> (sslength ss) 0)
            (progn
              (command "_.select" ss "")
              (setq tmp ss)
            ) ;_ end of progn
            (setq tmp nil)
          ) ;_ end of if
   ) ;_progn
   (alert
     "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss."
   ) ;_ end of alert
 ) ;_if
 (setvar "cmdecho" val)
 tmp
) ;_ end of defun