; TIP782.LSP   Enlarge an Area for a Detail   (c)1992, Victor V. Jensen
; -  Modified for Release 11.
; [DETAILS.LSP]

; Global variables: s#v, olderr.
(prompt "\nLoading functions")
; details error function
(defun deterr (S / A L)
(if (/= S "Function cancelled") (princ (strcat "\nError: " S)))
(command nil) (command ".UNDO" "B")
(foreach A s#v
  (if (= (car A) "CLAYER")
   (command "LAYER" "S" (cadr A) "") (setvar (car A) (cadr A))
))
(setq *error* olderr s#v nil olderr nil)
(princ)
)
(princ ".")
; sscross function
(defun sscross (/ S1 S2)
(setq S1 (ssget "C" P2 P3) S2 (ssget "W" P2 P3))
(if (/= (sslength S1) (sslength S2))
  (progn (command ".SELECT" S1 "R" S2 "") (ssget "p"))
) ; if
)
(princ ".")
; explode function
(defun explode (EN / A C E I L R S E1 E2 E3 S1 S2)
(setq S2 (ssadd))
(while (setq EN (entnext EN))
  (setq E (entget EN) ET (cdr (assoc 0 E)) E1 (cdr (assoc 41 E))
       E2 (cdr (assoc 42 E)) E3 (cdr (assoc 43 E))
  )
  (if (= HL 1) (redraw EN 3))
  (cond
   ((= ET "INSERT")
    (if (= (abs E1) (abs E2) (abs E3))
     (if (or (< E1 0) (< E2 0) (< E3 0))
      (progn
       (setq A (entlast) C (cdr (assoc 10 E)) I (cdr (assoc 2 E))
             L (cdr (assoc 50 E)) R (car C) S (cadr C)
       )
       (entdel EN) (setq S1 (ssadd))
       (command ".INSERT" (strcat "*" I) C (abs E1) 0)
       (while (setq A (entnext A)) (setq S1 (ssadd A S1)))
       (if (< E1 0) (command ".MIRROR" S1 "" C (list R (+ 10 S)) "Y"))
       (if (< E2 0) (command ".MIRROR" S1 "" C (list (+ 10 R) S) "Y"))
       (if (/= L 0) (command ".ROTATE" S1 "" C (* (/ 180 pi) L)))
      )
      (command ".EXPLODE" EN)
     )
     (ssadd EN S2)
   )) ; if
   ((member ET '("POLYLINE" "DIMENSION")) (command ".EXPLODE" EN))
   ((ssadd EN S2))
  ) ; cond
) ; while
(setq S1 (ssget "C" P2 P3))
(command ".ERASE" S2 "R" S1 "")
)
(princ ".")
; id function
(defun id (E / EN ET)
(setq EN (cdr (assoc -1 E)) ET (cdr (assoc 0 E)))
(if (= ET "ARC")
  (list EN ET (cdr (assoc 50 E)) (cdr (assoc 51 E))) (list EN ET)
) ; if
)
(princ ".")
; trim output function
(defun op (EN ET)
(if
  (not
   (and (<= (- (car P2) 1E-6) (car ET) (+ (car P3) 1E-6))
    (<= (- (cadr P2) 1E-6) (cadr ET) (+ (cadr P3) 1E-6))
  ))
  (progn (command (list EN ET)) T)
) ; if
)
(princ ".")
; trim function
(defun trim (/ I L EN ET EA SA S1 TM E C R D90 D270)
(while OK (setq OK nil I 0 S1 (sscross) L (if S1 (sslength S1) 0))
  (if (> L 0) (command ".TRIM" C2 ""))
  (repeat L (setq EN (ssname S1 I) E (entget EN) ET (cdr (assoc 0 E)) I (1+ I))
   (if (not (member (id E) TM))
    (progn (setq TM (cons (id E) TM))
     (cond
      ((= ET "LINE") (op EN (cdr (assoc 10 E))) (op EN (cdr (assoc 11 E))))
      ((= ET "CIRCLE") (setq C (cdr (assoc 10 E)) R (cdr (assoc 40 E)) OK T)
       (cond
        ((op EN (list (+ R (car C)) (+ 0.0 (cadr C)))))
        ((op EN (list (+ 0.0 (car C)) (+ R (cadr C)))))
        ((op EN (list (+ (- R) (car C)) (+ 0.0 (cadr C)))))
        ((op EN (list (+ 0.0 (car C)) (+ (- R) (cadr C)))))
      )) ; cond
      ((= ET "ARC")
       (setq C (cdr (assoc 10 E)) R (cdr (assoc 40 E)) SA (cdr (assoc 50 E))
            EA (cdr (assoc 51 E)) OK T D90 (/ pi 2) D270 (* pi 1.5)
       )
       (if (> SA EA) (setq EA (+ EA (* pi 2))))
       (cond
        ((op EN (polar C SA R)))
        ((op EN (polar C EA R)))
        ((or (<= SA 0.0 EA) (<= SA (* pi 2) EA)) (op EN (polar C 0.0 R)))
        ((or (<= SA D90 EA) (<= SA 0.0 EA)) (op EN (polar C D270 R)))
        ((or (<= SA pi EA) (<= SA (* pi 3) EA)) (op EN (polar C pi R)))
        ((or (<= SA D270 EA) (<= SA (* pi 3.5) EA)) (op EN (polar C D270 R)))
      )) ; cond
    )) ; cond
  )) ; if
  (if (> L 0) (command ""))
) ; while
)
(princ ".")
; main program
(defun C:DETAIL (/ A E I L R DT1 EN ET HL OK TM C1 C2 S1 P0 P1 P2 P3 P4 P5)
(setvar "cmdecho" 0)
(setq st (tblsearch "style" "romans"))
(if (= st nil)
  (command "style" "romans" "romans" "0.0" "1.0" "0.0" "n" "n" "n")
)
(setq st (strcase (cdr (assoc '3 (tblsearch "style" "romans")))))
(if (= st "ROMANS")
  (setvar "textstyle" "romans")
  (command "style" "romans" "romans" "0.0" "1.0" "0.0" "n" "n" "n")
)
(setq tsz (cdr (assoc '40 (tblsearch "style" "romans"))))
(if (/= tsz 0.0)
  (command "style" "romans" "romans" "0.0" "1.0" "0.0" "n" "n" "n")
)
(if (= txtsz nil)(setq txtsz 0.1875))
(setq txtsz1 (getdist (strcat "\nEnter Desired Text Size <" (rtos txtsz) ">: ")))
(if (/= txtsz1 nil)(setq txtsz txtsz1))
(setq ds (/ txtsz 0.1875))
(setq DT1 (* ds (getvar "DIMTXT")) HL (getvar "HIGHLIGHT")
   olderr *error* *error* deterr
        A '("HIGHLIGHT" "BLIPMODE" "OSMODE" "CLAYER" "ORTHOMODE")
      s#v (mapcar '(lambda (L) (list L (getvar L))) A)
)
(setvar "CMDECHO" 0) (setvar "BLIPMODE" 0) (setvar "OSMODE" 0)
(command ".UNDO" "M" ".LAYER" "S" "0" "ON" "0" "")
(while (= OK nil)
  (initget 1) (setq P1 (getpoint "\nDigitize Detail Centerpoint: "))
  (setq clay (getvar "clayer"))
  (setq tlay (tblsearch "layer" "phan"))
  (if (= tlay "phan")
   (setvar "clayer" "phan")
   (command "layer" "m" "phan" "c" "6" "" "lt" "phantom" "" "")
  )
  (princ "\nEncircle Details: ") (command ".CIRCLE" P1 PAUSE)
  (setvar "clayer" clay)
  (setq C1 (entlast) R (cdr (assoc 40 (entget C1))) L (sqrt (* (expt R 2) 2))
        P2 (append (list (+ (car P1) R) (cadr P1))) A (angle P2 P1)
        P2 (polar P1 (* A 1.25) L) P3 (polar P1 (* A 0.25) L)
        S1 (ssget "C" P2 P3)
  )
  (if (> (sslength S1) 1) (setq OK T)
   (progn (setq OK nil) (princ "\nNothing selected!") (command ".ERASE" C1 ""))
  ) ; if
) ; while
(setvar "ORTHOMODE" 0)
(princ "\nLocate Details: ") (command ".COPY" C1 "" P1 PAUSE)
(setq P4 (getvar "LASTPOINT") C2 (entlast))
(setvar "HIGHLIGHT" 0)
(command ".COPY" S1 "" P1 P4)
(setvar "HIGHLIGHT" HL)
(setq P2 (polar P4 (* A 1.25) L) P3 (polar P4 (* A 0.25) L) EN C2)
(princ "\nProcessing data...please wait.")
(explode EN)
(trim)
(setq S1 (sscross) L (if S1 (sslength S1) 0) I 0)
(repeat L (setq EN (ssname S1 I) E (entget EN) ET (cdr (assoc 0 E)) I (1+ I))
  (if (member ET '("LINE" "CIRCLE" "ARC")) (entdel EN))
)
(setvar "HIGHLIGHT" 0)
(initget 6)
(if (setq HL (getreal "\nScale factor <1.0000>: "))
  (command ".SCALE" "C" P2 P3 "" P4 HL)
)
(setq P3 (polar P4 (* A 1.5) (cdr (assoc 40 (entget C2))))
       P4 (polar P3 (* A 1.5) (* DT1 2)) P5 (polar P4 (* A 1.5) (* ds 0.350))
       TM (strcase (strcat "DETAIL " (getstring " Detail: ")))
       ET (strcat "SCALE: " (getstring " Scale: "))
)
(initget 1) (setq P2 (getpoint P1 "\nLocate Leader Text: "))
(if (or (<= (angle P1 P2) (/ A 2)) (>= (angle P1 P2) (* A 1.5)))
  (progn (setq I "ML" P3 (polar P2 0.0 (* DT1 2)) P0 (polar P2 0.0 (* DT1 2.5))))
  (progn (setq I "MR" P3 (polar P2 A (* DT1 2)) P0 (polar P2 A (* DT1 2.5))))
) ; if
  (setq tlay (tblsearch "layer" "dim"))
  (if (= tlay "DIM")
   (setvar "clayer" "dim")
   (command "layer" "m" "dim" "c" "3" "" "lt" "continuous" "" "")
  )
(command ".PLINE" P1 P2 P3 "" ".TRIM" C1 "" P1 "" ".TEXT" I P0 txtsz "0" TM)
(setq st (tblsearch "style" "block"))
(if (= st nil)
  (command "style" "block" "romanc" "0.0" "0.8" "0.0" "n" "n" "n")
)
(setq st (strcase (cdr (assoc '3 (tblsearch "style" "block")))))
(if (= st "BLOCK")
  (setvar "textstyle" "block")
  (command "style" "block" "romanc" "0.0" "0.8" "0.0" "n" "n" "n")
)
(setq tsz (cdr (assoc '40 (tblsearch "style" "block"))))
(if (/= tsz 0.0)
  (command "style" "block" "romanc" "0.0" "0.8" "0.0" "n" "n" "n")
)
(command ".TEXT" "M" P4 (* ds 0.250) "0" (strcat "%%U" TM))
(command "textstyle" "romans")
(command ".TEXT" "M" P5 txtsz "0" ET)
(setvar "clayer" clay)
(foreach A s#v
  (if (= (car A) "CLAYER")
   (command ".LAYER" "S" (cadr A) "") (setvar (car A) (cadr A))
))
(setq *error* olderr s#v nil olderr nil)
(princ)
) ; end program
(princ "loaded.")
(princ)