;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;  trim_in   ڿձ߽ڲͼ
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:trim_in ( / dxf na p1 redraw_it)
(if (not acet-error-init)
	(if
         (or
           (equal -1  (load "acetutil.fas"  -1))
		   (equal -1  (load "extrim.lsp"  -1))
		 );or
	(progn
    (alert "\nƽͼҪʹ AutoCAD Express еĲֹܣ\nȰװ˹ܻ Express ·ӵ AutoCAD ļ·!")
    (exit)
	);progn
	);if
);if

(acet-error-init (list
                   (list   "cmdecho" 0
                         "highlight" 0
                         "regenmode" 1
                            "osmode" 0
                           "ucsicon" 0
                        "offsetdist" 0
                            "attreq" 0
                          "plinewid" 0
                         "plinetype" 1
                          "gridmode" 0
                           "celtype" "CONTINUOUS"
                         "ucsfollow" 0
                          "limcheck" 0
                   )
                   F     ;flag. True means use undo for error clean up.
                   '(if redraw_it (redraw na 4))
                  );list
);acet-error-init

 ;local function
 (defun dxf (a b / ) (cdr (assoc a b)));defun

(princ "\nʰȡڿձ߽(POLYLINE)..")
(setq na (acet-ui-single-select '((-4 . "<OR")
                           (0 . "CIRCLE")
                           (0 . "ARC")
                           (0 . "LINE")
                           (0 . "ELLIPSE")
                           (0 . "ATTDEF")
                           (0 . "TEXT")
                           (0 . "MTEXT")
                           (0 . "IMAGE")
                           (0 . "LWPOLYLINE")
                           (-4 . "<AND")
                            (0 . "POLYLINE")
                            (-4 . "<NOT")
                              (-4 . "&")
                              (70 . 112)
                            (-4 . "NOT>")
                           (-4 . "AND>")
                          (-4 . "OR>")
                         )
                         T
         );acet-ui-single-select
);setq
(if na 
    (progn
     ;(setq e1 (entget na));;setq
     (redraw na 3)
     (setq redraw_it T)
     (setq p1 (getpoint "\nʰȡ߽һ:"));setq
     (redraw na 4)
     (setq redraw_it nil)

;;
(command "offset"  "0.1"  na  p1  "")
(setq nb (ssget "L"))
(setq nb (entlast))
(setq nb (entget nb))
(setq alist (vertexs nb))

;;
(if p1 (etrim na p1));if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(command "_.zoom" ".5x")
(setq nnn (nth 0 alist))
(setq pp1 (nth 1 alist))
(setq n1 2)
(command "_.ERASE" "CP" pp1)
(repeat  (- nnn 1)
   (setq  pp2 (nth n1 alist))
   (if  (and (/= (car pp2) (car pp1) )
             (/= (cadr pp2) (cadr pp1) )
        )
     (command pp2)
   )   
   (setq pp1 pp2)
   (setq n1 (+ n1 1))
);repeat
(command "" "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
    );progn
);if

;;(acet-error-restore)
(princ)
);defun c:trim_in



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;    trim_to  Ʊ߽ͼεָλ
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:trim_to ( / dxf na p1 redraw_it)
(if (not acet-error-init)
	(if
         (or
           (equal -1  (load "acetutil.fas"  -1))
		   (equal -1  (load "extrim.lsp"  -1))
		 );or
	(progn
    (alert "\nƽͼҪʹ AutoCAD Express еĲֹܣ\nȰװ˹ܻ Express ·ӵ AutoCAD ļ·!")
    (exit)
	);progn
	);if
);if

(acet-error-init (list
                   (list   "cmdecho" 0
                         "highlight" 0
                         "regenmode" 1
                            "osmode" 0
                           "ucsicon" 0
                        "offsetdist" 0
                            "attreq" 0
                          "plinewid" 0
                         "plinetype" 1
                          "gridmode" 0
                           "celtype" "CONTINUOUS"
                         "ucsfollow" 0
                          "limcheck" 0
                   )
                   F     ;flag. True means use undo for error clean up.
                   '(if redraw_it (redraw na 4))
                  );list
);acet-error-init

 ;local function
 (defun dxf (a b / ) (cdr (assoc a b)));defun

(setq na (entget (car  (entsel   "\nȡͼ߽(POLYLINE):"  ))))
(command "_.ZOOM" ".5X")
(setq pp6 (getpoint "\nȡͼλ:"));setq

(setq alist (vertexs na))
(setq nnn (nth 0 alist))
(setq pp1 (nth 1 alist))
(setq pp5 pp1)
(setq n1 2)
(command "_.COPY" "CP" pp1)
(repeat  (- nnn 1)
   (setq  pp2 (nth n1 alist))
   (command pp2)
   (setq n1 (+ n1 1))
);repeat
(command ""  "" pp5 pp6)

(setq dx (- (car pp6) (car pp5)))
(setq dy (- (cadr pp6) (cadr pp5)))
(setq nnn (nth 0 alist))
(setq n1 1)

(command "_.pline")
(repeat  (- nnn 1)
   (setq  pp1 (nth n1 alist))
   (setq pp1 (list (+ (car pp1) dx) (+ (cadr pp1) dy) ))
   (command pp1)
   (setq n1 (+ n1 1))
);repeat
   (setq  pp1 (nth nnn alist))
   (setq pp1 (list (+ (car pp1) dx) (+ (cadr pp1) dy) ))
   (command pp1)
(command "C")
(setq na (entlast))
(if na 
    (progn
     (redraw na 3)
     (setq redraw_it T)
     (redraw na 4)
     (setq redraw_it nil)
     (etrim na pp5)
    );progn
);if
(entdel na)

;;(acet-error-restore)
(princ)
);defun c:trim_to

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  trim_pmt  Զƽͼ
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:trim_pmt ( / dxf na redraw_it pp1  pp2  pp3  pp4  pp5  pp6)

(if (not acet-error-init)
	(if
         (or
           (equal -1  (load "acetutil.fas"  -1))
		   (equal -1  (load "extrim.lsp"  -1))
		 );or
	(progn
    (alert "\nƽͼҪʹ AutoCAD Express еĲֹܣ\nȰװ˹ܻ Express ·ӵ AutoCAD ļ·!")
    (exit)
	);progn
	);if
);if

(acet-error-init (list
                   (list   "cmdecho" 0
                         "highlight" 0
                         "regenmode" 1
                            "osmode" 0
                           "ucsicon" 0
                        "offsetdist" 0
                            "attreq" 0
                          "plinewid" 0
                         "plinetype" 1
                          "gridmode" 0
                           "celtype" "CONTINUOUS"
                         "ucsfollow" 0
                          "limcheck" 0
                   )
                   F     ;flag. True means use undo for error clean up.
                   '(if redraw_it (redraw na 4))
                  );list
);acet-error-init

(if (findfile "pmft.tmp")
    (princ "\n")    
    (progn
    (alert "\n   ȽƽͼԤ! ")
    (exit)
    );progn
);if

(setq fil1name (findfile "pmft.tmp"))
(setq fil1 (open  fil1name  "r"))



(princ "\nʼƽԶͼ...")
(while (setq page (read-line fil1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq page (atoi  page))
(princ "\n ")
(princ page)
(princ " ҳ")

(setq pp1 (list (distof (read-line fil1) 2) (distof (read-line fil1) 2)))
(setq pp2 (list (distof (read-line fil1) 2) (distof (read-line fil1) 2)))
(setq pp3 (list (distof (read-line fil1) 2) (distof (read-line fil1) 2)))
(setq pp4 (list (distof (read-line fil1) 2) (distof (read-line fil1) 2)))

(setq angr (distof (read-line fil1) 2))
(princ "\n")
;;(setq pp5 ( list
;;            (/ (+ (car pp1)  (car pp3)) 2)
;;            (/ (+ (cadr pp1) (cadr pp3)) 2)
;;          ) 
;;);setq
(setq pp5 ( list
            (/ (+ (car  pp1) (car pp2) (car pp3) (car pp4)) 4)
            (/ (+ (cadr pp1) (cadr pp2) (cadr pp3) (cadr pp4)) 4)
          ) 
);setq

(command "_.ZOOM" "E")
(setq pp6 (getpoint "\nȡͼλ:"));setq
(command "COPY" "CP" pp1  pp2  pp3  pp4  pp1  ""  ""  pp5   pp6)

(setq dx (- (car pp6) (car pp5)))
(setq dy (- (cadr pp6) (cadr pp5)))
(setq pp1 (list (+ (car pp1) dx) (+ (cadr pp1) dy) ))
(setq pp2 (list (+ (car pp2) dx) (+ (cadr pp2) dy) ))
(setq pp3 (list (+ (car pp3) dx) (+ (cadr pp3) dy) ))
(setq pp4 (list (+ (car pp4) dx) (+ (cadr pp4) dy) ))

(command "_.pline"  pp1 pp2 pp3 pp4  "c")
(setq na (entlast))

(if na 
    (progn
     (redraw na 3)
     (setq redraw_it T)
     (redraw na 4)
     (setq redraw_it nil)
     (etrim na pp5)
    );progn
);if
;;;(entdel na)

(setq nax  (ssget "CP" (list pp1 pp2 pp3 pp4 pp1)))
(command "_.ROTATE"  nax  ""  pp6  angr)
(command "_.INSERT"  "tk_pmt.dwg"  pp6 "" "" "")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
);while
;;(setq str1 (read-line fil1))
;;(princ "\n")
(close fil1)

;;(acet-error-restore)
(princ)
);defun c:trim_pmt


;;(entmake (list (cons 0 "POLYLINE")))
;;(entmake (list (cons 0 "VERTEX") (cons 10 pp1)))
;;(entmake (list (cons 0 "VERTEX") (cons 10 pp2)))
;;(entmake (list (cons 0 "VERTEX") (cons 10 pp3)))
;;(entmake (list (cons 0 "VERTEX") (cons 10 pp4)))
;;(entmake (list (cons 0 "VERTEX") (cons 10 pp1)))
;;(entmake (list (cons 0 "SEQEND")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vertexs(a)
(setq nnn (cdr (assoc 90 a)))
(setq ptn (cdr (assoc 10 a)))
(setq bijiao ptn)
(setq ptn (list ptn))
(setq newa (cdr (member (assoc 10 a) a)))
(setq a newa)
(setq nn1 nnn)
(repeat  (- nnn 1)
  (setq pt1 (cdr (assoc 10 a)))
  (if (and (= (car bijiao) (car pt1)) (= (cadr bijiao) (cadr bijiao)))
      (progn
      (setq newa (cdr (member (assoc 10 a) a)))
      (setq a newa)
      (setq nn1 (- nn1 1))
      )
     (progn
     (setq ptn (append ptn  (list pt1)))
     (setq newa (cdr (member (assoc 10 a) a)))
     (setq a newa)
     (setq bijiao pt1) 
     )
  )
);;repeat
(setq ptn (cons nn1 ptn))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Ϊ㻮ߵʾ״̬
(defun C:chl()
(setq ss (ssget));ѡʵ
(while ss
    (setq n (sslength ss)
                    i 0)
         (repeat n
             (setq sss (ssname ss i)   
                     i (+ i 1)
              )
  (command "pedit" sss "L" "on" "X")
	   )
  (setq ss (ssget));ѡʵ
  )
)
;;߻˫߼ͷ
(DEFUN C:ARW( / pt0 pt1 pt2 pt3 pt4 pt5 pt6 pt7 kwd ang dst)
       (setq kwd (crkword 0 "D S" "˫(D)" "<S>"))
       (setq pt0 (crpoint 1 "" "Base point" nil nil)
             pt5 (crpoint 1 "" "To " nil pt0)
       )
       (grdraw pt0 pt5 -1)
       (cond 
           ((and kwd (= kwd "D"))
                (setq ang (angle pt0 pt5)  
                      dst (distance pt0 pt5)
                      pt1 (polar pt0 (+ ang (/ pi 2.0)) (* 0.25 dst))
                      pt2 (polar pt0 (- ang (/ pi 2.0)) (* 0.25 dst))
                      pt3 (polar pt2 ang (* 0.35 dst))
                      pt4 (polar pt3 (- ang (/ pi 2.0)) (* 0.25 dst))
                      pt7 (polar pt1 ang (* 0.35 dst))
                      pt6 (polar pt7 (+ ang (/ pi 2.0)) (* 0.25 dst))
                 )
     (command "pline" pt1 "W" "0" "0" pt2 pt3 pt4 pt5 pt6 pt7 "c" "")
           )
           ((and kwd (= kwd "S"))
                (setq ang (angle pt5 pt0)
                      dst (distance pt0 pt5)
                      pt1 (polar pt5 (+ (dtor 10) ang) (* 0.35 dst))
                      pt2 (polar pt5 (- ang (dtor 10)) (* 0.35 dst))
                )
                (command "pline" pt0 "W" "0" "0" pt5 pt1 "")
                (command "redraw")
           )
       )
       (princ)
)
;;Ƕ
(defun c:ang()
   (setq p1 (getpoint "\n1st point:" )  )
   (setq P2 (getpoint "\n2nd point:"))
   (setq p3 (getpoint "\n3rd point:"))
   (setq a2 (angle p3 p2)
         a1 (angle p1 p2)
         a (- a2 a1)
         a (* 180.0 (/ a pi))
   )
  (print a)
  (princ)
)
;;
(defun c:cx()
   (setq p1 (getpoint "\nȡ:" )  )
   (setq P2 (getpoint "\nߵ:"))
   (setq a (angle p1 p2) )
   (setq q1 (polar p1 (+ a (/ pi 2)) 100)
         q2 (polar p1 (- a (/ pi 2)) 100)
   )
   (command "line" q1 q2  "")
)


;;;
(DEFUN C:DLX( / kwd objnm obj objtp ptsel leth pt0 pt1 pt2 pt3 pt4 ang)
       (setq kwd (crkword 0 "Midpoint neArp" "Any point/" "Midpoint"))
       (if (and kwd (= kwd "Midpoint"))
             (setvar "osmode" 2) 
             (setvar "osmode" 512)
       )
       (setq ptsel (crpoint 0 "" "Select a line or pline to modify" nil nil))
       (setvar "osmode" 0)
       (setq leth (crdist 0 "" "DLX length" nil ptsel))
       (setq objnm (ssname (ssget ptsel) 0))
       (if (> (sslength (ssget ptsel)) 1)
           (*error* "Too many entities.")
       )
       (setq obj   (entget objnm)
             objtp (dxf 0 obj) 
       )
       (cond 
                ((= objtp "LINE")
                         (setq obj    (entget objnm) 
                               ang    (angle (dxf 10 obj) (dxf 11 obj))
                         )
                )
                ((= objtp "POLYLINE")
                         (setq pt0 (ifin objnm ptsel)
                               ang (angle pt0 ptsel)
                         )
                )
        )
        (setq    pt1    (polar ptsel ang (/ leth 2.0))
                 pt2    (polar ptsel ang (* -1.0 (/ leth 2.0)))
                 pt3    (polar pt1 (+ ang (* pi 0.5)) (* leth 0.3))
                 pt4    (polar pt2 (+ (+ pi ang) (* pi 0.5)) (* leth 0.3))
        )
        (command "break" pt1 pt2)
        (command "pline" pt1 pt3 pt4 pt2 "")
        (redraw)
        (princ)
)
(DEFUN C:dm( / nn c1 c2 pt0 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 kwd ang dst )
       (setq pt0 (crpoint 1 "" "Base point" nil nil)
             pt5 (crpoint 1 "" "To " nil pt0))
       (setq ang  (angle pt0 pt5)  
             dst (distance pt0 pt5))

       (setq  c1 (cond ((<= dst 0.5 ) 0.0)
                        ((<= dst 1.0 ) 0.3)
                        ((<= dst 2.0 ) 0.6)
                        ((>  dst 2.0 ) 0.9)))
       (setq c2 (cond ((<= dst 2.0) 0.04)
                      ((> dst 2.0 ) 0.06))) 
       (setq    pt1 (polar pt0 ang c1)
                pt2 (polar pt1 (+ ang (/ pi 2.0)) c2)
                pt3 (polar pt5 ang (* -1 c1))
                pt4 (polar pt3 (- ang (/ pi 2.0)) c2)
                pt6 (polar pt0 (+ ang (/ pi 2)) 0.2)
                pt7 (polar pt0 (- ang (/ pi 2)) 0.2)
                pt8 (polar pt5 (+ ang (/ pi 2)) 0.2)
                pt9 (polar pt5 (- ang (/ pi 2)) 0.2)
                pt10 (polar pt0 ang (* 0.5 dst ))
                ;;;; nn (rtos dst 2 2)        
                nn (rtos (* dst 100) 2 0)        

         )
               (command "pline" pt0 "W" "0" "0" pt1 pt2 "c"  
                        "pline" pt1 pt5 pt4 pt3 ""
                        "line" pt6 pt7  ""         
                        "line" pt8 pt9  ""  
                        "text" "j" "bc" pt10 "0.6" pt5 nn)
        (princ)
)



;;׶,: ܿҫ
(defun C:zp()
      (setq p1 (getpoint "\n·Ե:"))
      (setq p2 (getpoint p1 "\n׶е:"))
      (command "line" p1 p2 "")
      (setq p3 (getpoint p2 "\n½űԵ:"))
      (setq jd1 (angle p2 p1))
      (setq pi 3.14159265)
      (setq jd2 (angle p2 p3))
      (setq d1 (distance p1 p2))
      (setq d2 (distance p2 p3))
      (setq p21 (polar p2 jd1 (+ d1 10.0)))
      (setq p31 (polar p2 jd2 (+ d2 10.0)))
      (command "line" p2 p21 "")
        (setq s1 (ssget "l"))
        (command "line" p2 p31 "")
        (setq s2 (ssget "l"))
      (setq jd0 (- jd2 jd1))  (princ jd0)
      (if (> jd0 pi) (setq kg 1) (setq kg -1))
      (if (> jd0 pi) (setq jd0 (- (* 2 pi) jd0)))
      (if (< jd0 (- 0 pi)) (setq jd0 (+ pi pi jd0)))
      (if (< jd0 0) (setq kg 1))
            (setq jd0 (abs jd0))
     ;---------ȷԲ----------------------------------
      (if (> jd0 1.5707963) (setq jd01 (- pi jd0)) (setq jd01 jd0))  
      (setq a (+ (* d1 d1) (* d2 d2)))
      (setq b (* d1 d2 (sin jd01)))
      (setq a1 (+ a (* 2 b)))
      (setq b1 (- a (* 2 b)))
      (setq sl (/ (- (sqrt a1) (sqrt b1)) 2))
      (setq ll (/ (+ (sqrt a1) (sqrt b1)) 2))
      (setq sl (abs sl))
      (setq ll (abs ll))
      ;-------------------------------------------
      (princ sl) (princ ll)
      ;------btȷԲбļн------------
       (setq a2 (abs (* (+ d2 ll) (- d2 ll))))
       (setq b2 (abs (* (+ sl d2) (- sl d2))))
           (setq a2 (sqrt a2))
           (setq b2 (sqrt b2))
       (if (> jd0 1.5707963) (progn (if (= kg -1) (setq bt (atan (* ll b2) (* sl a2)))
                                                  (setq bt (atan (* sl a2) (* ll b2)))
                                     )
                             )
       )
;*******************
       (if (<= jd0 1.5707963) (progn (if (= kg 1) (setq bt (atan (* ll b2) (* sl a2)))
          (setq bt (atan (* sl a2) (* ll b2)))
        )))

       ;-----ȷԲλ-------------  
       (if (> jd0 1.5707963) (progn (if (= kg 1) (setq pl (polar p2 (- jd2 bt) ll))
                                       (setq pl (polar p2 (- jd2 bt 1.5707963) ll))
                                     )
                              )
        )
       (if (<= jd0 1.5707963) (progn (if (= kg 1) (setq pl (polar p2 (- jd2 bt 1.5707963) ll))
                                                  (setq pl (polar p2 (- jd2 bt) ll))
                                      )
                               )
       )
       ;-----------------------------------------
   (if (> jd0 1.5707963)   
    (progn
         (setq jd (/ jd0 6 kg))
         (setq p11 (polar p2 (+ jd2 jd) (* d1 0.7))
               p12 (polar p2 (+ jd2 (*  2 jd)) d1)
               p13 (polar p2 (+ jd2 (*  3 jd)) (* d1 0.7))
               p14 (polar p2 (+ jd2 (*  4 jd)) d1)
               p15 (polar p2 (+ jd2 (*  5 jd)) (* d1 0.7))
          )
        (command "line" p2 p11 "")
        (command "line" p2 p12 "")
        (command "line" p2 p13 "") 
        (command "line" p2 p14 "")
        (command "line" p2 p15 "") 
        (command "ellipse" "c" p2 pl sl)
        )
     (progn
        (setq jd (/ jd0 4 kg)) 
        (setq p11 (polar p2 (+ jd2 jd) (* d1 0.7))
              p12 (polar p2 (+ jd2 (*  2 jd)) d1)
              p13 (polar p2 (+ jd2 (*  3 jd)) (* d1 0.7))
              p14 (polar p2 (+ jd2 (*  4 jd)) d1)
        )
        (command "line" p2 p11 "")
        (command "line" p2 p12 "")
        (command "line" p2 p13 "")      
        (command "ellipse" "c" p2 pl sl)
     )
    )
        ;(setq p4 (polar p2 (- jd2 bt pi) ll))
        ;(setq s3 (ssget p4))  
        (setq s3 (entsel "\nѡɾ:"))
        (command "trim" s1 s2 "" s3 "")
        (command "erase" s1 s2 "")
        (command "line" p2 p3 "")
        (redraw)
)
;---------------------------------------
;          dtor
;     turn degree to r
;---------------------------------------
(DEFUN DTOR(deg / )
     (* deg (/ pi 180.0))
)
;-------------------------------------------
;                CRKWORD
; FROMAT: (crkword bit kwd msg default)
;-------------------------------------------
(DEFUN CRKWORD(bit kwd msg default / inp)
       (if (and default (/= default ""))
                (setq msg (strcat "\n" msg "<" default ">: ")
                      bit (* 2 (fix (/ bit 2)))
                )
                (setq msg (strcat "\n" msg ": "))
       )
       (initget bit kwd)
       (setq inp (getkword msg))
       (if inp inp default)
)
;-------------------------------------------
;                CRPOINT
; FROMAT: (crpoint bit kwd msg default bpt)
;-------------------------------------------
(DEFUN CRPOINT(bit kwd msg default bpt / inp pts)
       (if default
              (setq pts (strcat  (rtos (car default))
                                 ", "
                                 (rtos (cadr default))
            (if (and (caddr default) (= 0 (getvar "flatland")))
                                     (strcat     ", "
                                     (rtos (caddr default))
                                                 " "
                                     )
                                 )
                         )
                     msg (strcat "\n" msg "<" pts ">: ")
                     bit (* 2 (fix (/ bit 2)))
              )
              (setq msg (strcat "\n" msg ": "))
       )
       (initget bit kwd)
       (setq inp 
               (if bpt
                     (getpoint bpt msg)
                     (getpoint msg)
               )
       )
       (if inp inp default)
)
;---------------------------------
;      process error
;---------------------------------
(defun *error* (msg)
      (setq msg (strcat "\nError:" msg "."))
      (setvar "osmode" 0)
      (princ msg)
      (princ)
)
;--------------------------            
;        IFIN
; FUNCTION: TO FIND 
; FORMAT:IFIN(ENTNAME PT1)
;--------------------------
(DEFUN IFIN(objnm ptm / objn obj pt1)
       (setq objn (entnext  objnm)
             obj  (entget objn)
             pt1  (dxf 10 obj)
       )
       (while  (and (setq objn (entnext objn))     
                    (setq obj (entget objn))
                    (/= "SEQEND" (dxf 0 obj))
                    (/= (angle pt1 (dxf 10 obj)) (angle ptm (dxf 10 obj)))
                    (/= pt1 ptm)
                    (/= ptm (dxf 10 obj))
               )
              (setq pt1 (dxf 10 obj))
       )
       pt1
)

;-------------------------------------------
;                 CRDIST
; FROMAT: (crdist bit kwd msg default bpt)
;-------------------------------------------
(DEFUN CRDIST(bit kwd msg default bpt / inp)
       (if default
           (setq msg  (strcat "\n" msg "<" (rtos default) ">: ")
                 bit  (* 2 (fix (/ bit 2)))
           )
           (setq msg  (strcat "\n" msg ": "))
       )
       (initget bit kwd)
       (setq inp
           (if bpt
               (getdist bpt msg)
               (getdist msg)
           )
       )
       (if inp inp default)
)

;-------------------------------------------
;                 CRDXF
;       FROMAT: (crdxf code elist)
;-------------------------------------------
(DEFUN DXF(code elist)
       (cdr (assoc code elist))
)
;; Silent load.
(princ)

