;; ************************************************************************
;;;                I N  T H E   N A M E   O F   G O D
(defun ipnlisp ()
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (setq cl (getvar "clayer"))
 (setq ts (getvar "textstyle"))
 (princ (strcat "\n       * * *   W E L C O M E   T O  < POS >  P "
                                  "R O G R A M   * * * "))
 (princ (strcat "\nInsert Position , Version  1.0 "
                 ", (c) 1993 by R. Negarandeh ."))
  ;;
  ;; Body of function
  ;;
  (if *error*                         ; Set our new error handler
    (setq err_oe *error* *error* err_er)
    (setq *error* err_er)
  )

 (if (= (tblsearch "block" "fl1") nil) (mflesh))


       (if (= (tblsearch "style" "pos" ) nil)
           (command "style" "pos" "simplex" "" "" "10" "" "" "")
           (setvar "textstyle" "pos" )
       )


       (if (= (tblsearch "layer" "pos" ) nil)
           (command "layer" "m" "pos" "c" "1" "" "")
           (command "layer" "s" "pos" "")
       )

 (if
     (= size1 nil )(setq size1 1)
 )
 (setq size2 (rtos size1 2 0))
 (princ (strcat "\nEnter flesh size <" size2))
 (setq size (getreal ">:"))
 (if
     (= size nil) (setq size size1 )
 )
 (setq size1 size)
 (setq posrad (* size 2.5))
 (setvar "textsize" posrad)
 (setq yscale 0.75)
 (setq ysize (* size yscale))
 (if (= post nil )(setq post "1"))
     (princ (strcat "\nPos. :<" post))
      (setq post1 (getstring ">: "))
       (if
          (= post1 "") (setq post1 post )
       )
     (setq post post1)
   (setq stp   (getpoint "\nInsertion point :"    ))
     (command "line" stp pause "")
     (setq fst (entlast))
     (setq st 1)
     (while (/= st  nil)
       (setq w (getpoint "\n Continue ?<Left=Yes & Right=No>"))
       (if (= w nil) (setq st nil))
       (if (/= st nil)
       (progn
       (setq stp (getvar "lastpoint"))
       (command "line" stp pause "")
       ))
       (setq f (entlast))
     )
                       (setq p (cdr (assoc 10 (entget f))))
                       (setq q (cdr (assoc 11 (entget f))))
                       (setq a (* 180 (/ (angle p q ) pi)))
                       (setq p1 (cdr (assoc 10 (entget fst))))
                       (setq q1 (cdr (assoc 11 (entget fst))))
                       (setq a1 (* 180 (/ (angle q1 p1 ) pi)))
                       (command "insert" "fl1" p1 size ysize a1)
                           (setq poscen (polar q (angle p q) posrad))
                           (command "circle" poscen posrad)
                           (command "text" "j" "m" poscen "" "" post )
    (print)
  (if err_oe (setq *error* err_oe))   ; Reset old error function if error
  (princ)
 (princ "\n     Good Luck .   ")
 (setvar "blipmode" 1)
 (setvar "cmdecho" 1)
 (setvar "clayer" cl)
 (setvar "textstyle" ts)
 (prin1 )
)

(defun mflesh ()
         (setq basep (list 0 0 0))
         (setq centp (list -1.2547 0 0))
         (setq frstp (list -1 -0.2679 0))
         (setq bangl 316.4468877)
         (setq radpt 0.369651863)
         (setq nsold 10)
         (setq aangl (/ (- 360 bangl) nsold))
         (setq ssblock (ssadd))
         (setq n 0)
           (while (> (* 2 nsold) n)
             (setq pt1 (polar centp  (dtr (+ bangl (* n aangl))) radpt ))
             (setq pt2 (polar centp  (dtr (+ bangl (* (+ n 1) aangl))) radpt ))
             (command "layer" "s" "0" "" )
             (command "solid" pt1 basep pt2 "" "")
             (ssadd (entlast) ssblock)
             (setq n (+ n 1))
           )
         (command "block" "fl1"  basep ssblock "")
)

(setq ipnid 1)
(defun C:IPN () (ipnlisp))
(princ "\n      <Insert Position> loaded.  Start command with IPN .")
(princ )
; ************************************************************************
