;;;標示汽球


(defun c:FH( / d h B  DS CLAY PP1) 
   (SetQ DS (GETVAR "DIMSCALE"))
   (setq clay (getvar "clayer"))
   (setq d (/ DS 0.25))
   (setq h (/ DS 0.5))
   (setvar "osmode" 0)  
   (IF (or (= FHA nil) (< FHA 65) (> FHA 90)) (SETQ FHA 65))
   (SETQ B (GETSTRING "\n重新開始計數(Y/N)<N>;"))
  (IF (OR (= B "Y") (= B "y"))
      (PROGN
        (PRINC "\n輸入開始字母(A~Z):") (princ "<")
        (PRINC (CHR FHA)) (princ ">")
        (SETQ n (ascii (STRCASE (GETSTRING))))
        (SETQ FHA n)
        ))
  (command "layer" "s" "LOUT" "")
  (setq pp1 (getpoint "\nPrint start point:"))
  (while (AND (/= pp1 nil) ( < FHA 91))
     (progn       
          (command "circle" pp1 "d" d  "")
          (command "text" "j"  "mc" pp1 h "" (STRCASE (chr FHA)) "" )          
          (SETQ FHA (+ FHA 1))
          (setq pp1 (getpoint "\nPrint start point:"))
     )
  )
  (setvar "osmode" 39)
  (command "layer" "S" CLAY  "")
)


;;標注件號后,用它使件號從左至右,或從上至下按順序排例.

 (defun c:bom ( / txt v1  v3 tp snew new old unt prec)
 (setvar "cmdecho" 0)
 (command "_.UNDO" "_group")
 (if (not *uglb)(setq *uglb 2))
 (if (not *prglb)(setq *prglb 0))
 (if (not *incglb)(setq *incglb 1.0))
          (princ "選取需排序之文字: ")


    (setq pointt1 (getpoint ))
    (setq pointt3 (getcorner pointt1 "\nOther corner:")  )

          (setq v1 (ssget "c" pointt1 pointt3 '((0 . "TEXT")) ))
         ; (prin1 "pointt1=")(princ pointt1)(print )(setq pointt1 nil)
          ;(prin1 "pointt3=")(princ pointt3)(print )(setq pointt2 nil)


      (if (> (abs (- (car pointt1) (car pointt3)) )  (abs (- (cadr pointt1) (cadr pointt3))) )
          (progn
          (setq i 0)
          (setq ss2 (ssadd))
       (repeat (sslength V1) 
          (setq M (entget (ssname V1 i)))
          (setq i (+ 1 i))
          (SETQ MEN (cadr (assoc 10 M)))
          (IF (= I 1) (SETQ MEN1 MEN  M1 M  MEN0 MEN  M0 M  ))
          (IF (< MEN MEN1) (SETQ MEN1 MEN MEN0 MEN M0 M) ) 

        )
       (setq m0 (cdr (assoc -1 m0)))
       (SSADD M0 SS2)
;(print (sslength ss2))


          (setq i 0)
       (repeat (sslength V1) 
          (setq t (entget (ssname V1 i)))
          (setq i (+ 1 i))
          (SETQ K 0)

       (repeat (sslength V1) 
          (setq M (entget (ssname V1 K)))
          (setq K (+ 1 K))
          (SETQ MEN (cadr (assoc 10 M)))
         (IF (AND (= L NIL)(> MEN MEN0))  (SETQ MEN1 MEN M1 M  L 1)) 
         (IF (AND (< MEN0 MEN)(OR (EQUAL MEN MEN1 0.001) (< MEN MEN1)))    (SETQ MEN1 MEN M1 M)  )
        )

       (IF M1 
        (PROGN
        (setq m1 (cdr (assoc -1 m1)))     
        (SSADD M1 SS2) )
        )

       (SETQ L NIL)
       (SETQ M1 NIL) 
        (SETQ MEN0 MEN1)
       )
     );progn

;;;;;;

          (progn
          (setq i 0)
          (setq ss2 (ssadd))
       (repeat (sslength V1) 
          (setq M (entget (ssname V1 i)))
          (setq i (+ 1 i))
          (SETQ MEN (caddr (assoc 10 M)))
          (IF (= I 1) (SETQ MEN1 MEN  M1 M  MEN0 MEN  M0 M  ))
          (IF (> MEN MEN1) (SETQ MEN1 MEN MEN0 MEN M0 M) ) 

        )
       (setq m0 (cdr (assoc -1 m0)))
       (SSADD M0 SS2)
;(print (sslength ss2))


          (setq i 0)
       (repeat (sslength V1) 
          (setq t (entget (ssname V1 i)))
          (setq i (+ 1 i))
          (SETQ K 0)

       (repeat (sslength V1) 
          (setq M (entget (ssname V1 K)))
          (setq K (+ 1 K))
          (SETQ MEN (caddr (assoc 10 M)))
         (IF (AND (= L NIL)(< MEN MEN0))  (SETQ MEN1 MEN M1 M  L 1)) 
         (IF (AND (> MEN0 MEN)(OR (EQUAL MEN MEN1 0.001) (> MEN MEN1)))    (SETQ MEN1 MEN M1 M)  )
        )

       (IF M1 
        (PROGN
        (setq m1 (cdr (assoc -1 m1)))     
        (SSADD M1 SS2) )
        )

       (SETQ L NIL)
       (SETQ M1 NIL) 
        (SETQ MEN0 MEN1)
       )
     );progn

)


          ;(initget "Scientific Decimal Engin Arch")
          ;(setq tp (getkword "\nEnter unit type Scientific/Decimal/Engin/Arch <D>: "))
          (cond
                ((= tp "Scientific")(setq unt 1))
                ((= tp "Decimal")(setq unt 2))
                ((= tp "Engin")(setq unt 3))
                ((= tp "Arch")(setq unt 4))
                ((not tp) (setq unt *uglb))
          )
          (setq uglb unt)
          ;(setq prec (getint (strcat "\nEnter precision value <" (itoa *prglb) ">: ")))
          (if (not prec)
             (setq prec *prglb)(setq *prglb prec)
          )
          ;(setq inc (getreal (strcat "\nEnter increment value <" (rtos *incglb 2 2) ">: ")))
          (if (not inc)
              (setq inc *incglb)(setq *incglb inc)
          )
          (setq new (getreal "\n請輸入起始值: <1> "))
          (if (not new)
              (setq new 1)
          )

          (setq v2 0)
             (if (and SS2 new)
                 (while (< v2 (sslength SS2))
                        (setq snew (rtos new unt prec))
                        (setq snew (cons 1 snew))
                        (setq txt (ssname SS2 v2))
                        (setq old (assoc 1 (setq v3 (entget txt))))
                        (entmod (subst snew old v3))
                        (entupd txt)
                        (setq new (+ new inc))
                        (setq v2 (+ v2 1))
                 )
             )

(command "_.UNDO" "_E")
(princ)
)

(defun start00 () 
(setq olderr *error* 
        *error* clerr)
  (setq osnap (getvar "osmode"))
  (setq scmde (getvar "CMDECHO"))
  (setq clay (getvar "CLAYER"))
  (setq sblip (getvar "BLIPMODE"))
  (setq sgrid (getvar "GRIDMODE"))
  (setq shl (getvar "HIGHLIGHT"))
  (setq sucsf (getvar "UCSFOLLOW"))
  (setvar "CMDECHO" 0)
  (command "_.UNDO" "_GROUP") 
  (command "_.UCS" "" ) 
 )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;生成件號標注
(defun c:HF()
          (start00)
           (setvar "osmode" 0)
          (setq scalebase (getvar "dimscale"))
             (setq kit nil)
             (setq kit 1)
           (while (< kit 5)
             (setq base0 (getpoint "\nEnter the 1st point:")  )
            (if (null base0) (princ "無效的點!請重輸:")(setq kit 6)
              );if
             );while
             (setq kit nil)

             (setq orthomode (getvar "orthomode"))
             (COMMAND "ORTHO" "OFF")
             (SETQ BASE0X (CAR BASE0))
             (SETQ BASE0Y (CADR BASE0))
             (setq base1 (getpoint base0 "\nEnter the 2st point:")  )
             (setq poin0 (cadr (grread T)))
             (setq poin0x (car poin0))
             (setq poin0y (cadr poin0))
;(PRINC "POIN0=")(PRIN1 POIN0)(PRINT)
             (setq base1x (car base1))
             (setq base1y (cadr base1))
         (IF (= BASE1 NIL)
              (progn
              (if (> (abs (- poin0y base0y)) (abs (- poin0x base0x) ))
                (progn
                 (setq base1x (+ base2x (* 3 scalebase)))
                 (setq base1y base2y)
                 (setq base1 (list base1x base1y)) 
                 )
                (progn
                 (setq base1x base1xb)
                 (setq base1y (- base1Yb (* 8 scalebase)))
;(PRINC "BASEYB=")(PRIN1 BASE1YB)(PRINT)
                 )
               )

               )
           )
              (setq base1 (list base1x base1y))
              (setq base1xb base1x)
              (setq base1yb base1y)

             (setq base2x (+ base1x (* 6 scalebase) ) )
             (setq base2y base1y)   
             (setq base2 (list base2x base2y))

            (if (> base0x base1x)
              (progn
                (setq poin base1)
                (setq base1 base2)
                (setq base2 poin)
               )
             )              
             (setq textbase (list (+ base1x scalebase)(+ base1y scalebase)))
(if (= text1 nil) (setq text1 1))
(print) (PRINc "Enter an integer value <")(PRIN1 text1)(princ ">")
             (setq text (getint )  )
             (command "pline" base0 base1 base2 "")
             (if (= text nil) (setq text text1))
             (setq text1 (+ 1 text) )
             (setq height (* 4 scalebase))
             (command "text" textbase height "" text)
             (SETQ BASE2XB BASE2X)
             (setq base2yb base2y)
             (setvar "osmode" OSNAP)
             (setvar "orthomode" orthomode)
             (command "UNDO" "E")
             (setvar "CMDECHO" scmde )
             (PRINC)
 )
(defun start00 () 
(setq olderr *error* 
        *error* clerr)
  (setq osnap (getvar "osmode"))
  (setq scmde (getvar "CMDECHO"))
  (setq clay (getvar "CLAYER"))
  (setq sblip (getvar "BLIPMODE"))
  (setq sgrid (getvar "GRIDMODE"))
  (setq shl (getvar "HIGHLIGHT"))
  (setq sucsf (getvar "UCSFOLLOW"))
  (setvar "CMDECHO" 0)
  (command "_.UNDO" "_GROUP") 
  (command "_.UCS" "" ) 
 )
