;;;---------------------------------------------------------------------------
;;;   
;;;   syukudai.lsp
;;;   For AutoCAD 2000
;;;   
;;;---------------------------------------------------------------------------
(defun syukudai (flg /
                 tmp get_user_input undo_end undo_begin
                 syukudai_main1 syukudai_main2
                 delete_sset make_insert make_block rtos_dzn
                )
  (defun rtos_dzn (REAL / dzn STR)
    (setq dzn (getvar "dimzin"))(setvar "dimzin" 0)
    (setq STR (rtos REAL))(setvar "dimzin" dzn)
    STR
  )
  ;;;-------------------------------------------------------------------------
  (defun make_block (sset pnt bnm / flg bnm enm)
    (if (= bnm nil)(setq flg 1 bnm "*xxx")(setq flg 0))
    (setq ssln (sslength sset))
    (entmake(list(cons  0 "BLOCK")(cons 100 "AcDbEntity")
      (cons 67 0)(cons 8 "0")(cons 100 "AcDbBlockBegin")
        (cons 70 flg)(cons 10 pnt)(cons 2 bnm)(cons 1 "")))
    (while (>= (setq ssln (1- ssln)) 0)
      (setq elst (entget(ssname sset ssln)'("*")))
      (if (= "POLYLINE" (cdr(assoc 0 elst)))
        (progn
          (entmake elst)
          (setq elst (entget(entnext(cdr(assoc -1 elst)))'("*")))
          (while (/= "SEQEND" (cdr(assoc 0 (cdr elst))))
            (entmake elst)
            (setq elst (entget(entnext(cdr(assoc -1 elst)))'("*")))
          )
          (entmake elst)
        )
        (entmake elst)
      )
    )
    (entmake (list(cons 0 "ENDBLK")(cons 100 "AcDbEntity")
      (cons 67 0)(cons 8 "0")(cons 100 "AcDbBlockEnd")))
  )
  ;;;-------------------------------------------------------------------------
  (defun make_insert (bnm pnt xsl ysl zsl ang /)
    (entmake(list(cons 0 "INSERT")(cons 100 "AcDbEntity")(cons 67 0)
      ;|(cons 410 (getvar "ctab"))|;(cons 8 (getvar "clayer"))
        (cons 100 "AcDbBlockReference")(cons 2 bnm)(cons 10 pnt)
          (cons 41 xsl)(cons 42 ysl)(cons 43 zsl)(cons 50 ang)))
  )
  ;;;-------------------------------------------------------------------------
  (defun delete_sset (sset / len)
    (setq len (sslength sset))
    (while (>= (setq len (1- len))0)
      (entdel (ssname sset len))
    )
  )
  ;;;-------------------------------------------------------------------------
  (defun undo_begin(/ ecbk)
    (setq ecbk(getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (command "_.undo" "_begin")
    (setvar "cmdecho" ecbk)
  )
  ;;;-------------------------------------------------------------------------
  (defun undo_end(/ ecbk)
    (setq ecbk(getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (command "_.undo" "_end")
    (setvar "cmdecho" ecbk)
  )
  ;;;-------------------------------------------------------------------------
  (defun syukudai_main1(lst / sset pnt0 pnt1 pnt2 ang int
                       dst0 dst1ang1 ang2 cnt elist ecbk)
    (setq sset (car lst)
          pnt0 (cadr lst)
          pnt1 (caddr lst)
          pnt2 (cadddr lst)
          pnt2 (list (car pnt2)(cadr pnt2)(caddr pnt1))
          ang  (nth 4 lst)
          int  (nth 5 lst)
    )
    (make_insert (make_block sset pnt0 nil) pnt1 1.0 1.0 1.0 0.0)
    (delete_sset sset)
    (setq dst0 (distance pnt1 pnt2) dst1 (/ dst0 int)
          ang0 (* ang (/ pi 180)) ang1 (angle pnt1 pnt2)
          ang2 (/ ang0 int) cnt 0 elst (entget(entlast))
    )
    (princ "\n")
    (while (>= int (setq cnt(1+ cnt)))
      (setq elst (subst(cons 10(polar pnt1 ang1
                   (* dst1 cnt)))(assoc 10 elst)elst)
            elst (subst(cons 50(* ang2 cnt))(assoc 50 elst)elst)
      )
      (entmod elst)
      ;(entmake elst)
      (redraw (entlast))
      (setq ecbk(getvar "cmdecho"))
      (setvar "cmdecho" 0)
      (command "_.delay" 0)
      (setvar "cmdecho" ecbk)
      (princ (strcat "\r実行中:" (itoa cnt) "/" (itoa int) "\t\t"))
    )
    (princ "\n")
    (setq ecbk(getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (command "_.explode" (entlast))
    (setvar "cmdecho" ecbk)
    (princ)
  )
  ;;;-------------------------------------------------------------------------
  (defun syukudai_main2(lst / sset pnt0 pnt1 pnt2 ang int
                       dst0 dst1ang1 ang2 cnt elist ecbk)
    (setq sset (car lst)
          pnt0 (cadr lst)
          pnt1 (caddr lst)
          pnt2 (cadddr lst)
          pnt2 (list (car pnt2)(cadr pnt2)(caddr pnt1))
          ang  (nth 4 lst)
          int  (nth 5 lst)
    )
    (make_insert (make_block sset pnt0 nil) pnt1 1.0 1.0 1.0 0.0)
    (delete_sset sset)
    (setq dst0 (distance pnt1 pnt2) dst1 (/ dst0 int)
          ang0 (* ang (/ pi 180)) ang1 (angle pnt1 pnt2)
          ang2 (/ ang0 int) cnt 0 elst (entget(entlast))
    )
    (princ "\n")
    (while (>= int (setq cnt(1+ cnt)))
      (setq elst (subst(cons 10(polar pnt1 ang1
                   (* dst1 cnt)))(assoc 10 elst)elst)
            elst (subst(cons 50(* ang2 cnt))(assoc 50 elst)elst)
      )
      ;(entmod elst)
      (entmake elst)
      (redraw (entlast))
      (setq ecbk(getvar "cmdecho"))
      (setvar "cmdecho" 0)
      (command "_.delay" 0)
      (setvar "cmdecho" ecbk)
      (princ (strcat "\r実行中:" (itoa cnt) "/" (itoa int) "\t\t"))
    )
    (princ "\n")
    ;(setq ecbk(getvar "cmdecho"))
    ;(setvar "cmdecho" 0)
    ;(command "_.explode" (entlast))
    ;(setvar "cmdecho" ecbk)
    (princ)
  )
  ;;;-------------------------------------------------------------------------
  (defun get_user_input(/ sset pnt0 pnt1 pnt2 ang int tmp)
    (if(setq sset (ssget))
      (progn
        (setq pnt0 nil pnt1 nil pnt2 nil ang nil int nil)
        (while (= nil (and pnt0 pnt1 pnt2 ang int))
          (if (= nil pnt0)
            (setq pnt0 (getpoint "\n選択した図形群の基準点: "))
          )
          (if (= nil pnt1)
            (if(/= nil pnt0)
              (setq pnt1(getpoint(strcat "\n始点を指示< "
                (strcat(rtos_dzn (car pnt0))","(rtos_dzn (cadr pnt0))","
                  (rtos_dzn (caddr pnt0)))" >: ")))
              (setq pnt1 (getpoint"\n始点を指示: "))
            )
          )
          (if (= nil pnt1)(setq pnt1 pnt0))
          (if (= nil pnt2)
            (if (/= nil pnt1)
              (setq pnt2 (getpoint pnt1 "\n終点を指示: "))
              (setq pnt2 (getpoint "\n終点を指示: "))
            )
          )
          (if (= nil ang)(setq ang (getreal "\n回転角度<360>: ")))
          (if (= nil ang)(setq ang 360))
          (if (= nil int)
            (progn (initget 4)(setq int (getint "\nステップ<100>: ")))
          )
          (if (= nil int)(setq int 100))
          (if (= nil (and pnt0 pnt1 pnt2 ang int))
            (princ "\n無効な入力があります.")
          )
        )
        (setq tmp (list sset pnt0 pnt1 pnt2 ang int))
      )
      (setq tmp nil)
    )
    tmp
  )
  ;;;---------------------------------------------------------------------------
  (if (= 0 (getvar "cmdactive"))
    (if (setq tmp (get_user_input))
      (progn(undo_end)(undo_begin)
        (cond ((= flg 1)(syukudai_main1 tmp))
              ((= flg 2)(syukudai_main2 tmp))
        )
        (undo_end)
      )
    )
    (progn
      (alert "このコマンドは割り込みで実行できません.")
      (princ (strcat "\n" (getvar "cmdnames") " ｺﾏﾝﾄﾞ再開."))
    )
  )
  (princ)
)


(defun c:syukudai ()(syukudai 1))
(defun c:syukudai2()(syukudai 2))

;(defun c:xxx()(c:SYUKUDAI))
;(defun c:zzz()(c:SYUKUDAI2))
(princ "\nCommand name:\n\tsyukudai  - のーまる\n\tsyukudai2 - 軌跡付き")
(princ)
;;;---------------------------------------------------------------------------
;;;EOF