Detail Lisp

[paul9ZMBV]

Hi,

I would like a Lisp to enable me to draw a circle and and then it copies everything in the circle and then asks for a scale to enlarge it.

I have found a lisp online (below) and it kind of work, but seems to do other things after it has scaled it but i cant work out what the other features are, perhaps someone can read the lisp below and work it out please.

; 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:DETAILS (/ A E I L R DT EN ET HL OK TM C1 C2 S1 P0 P1 P2 P3 P4 P5)
(setq DT (* (getvar "DIMSCALE") (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 "\nDetail centerpoint: "))
(princ "\nEncircle detail: ") (command ".CIRCLE" P1 PAUSE)
(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 detail: ") (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) (* DT 2)) P5 (polar P4 (* A 1.5) (* DT 2))
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)))
;--------------------------------- Release 9 ----------------------------------
; (progn (setq I "L" P3 (polar P2 (- A pi) (* DT 2))
; P0 (polar P2 (- (* A 2) 0.167) (* DT 2.6)))
; )
; (progn
; (setq I "R" P3 (polar P2 A (* DT 2)) P0 (polar P2 (+ A 0.167) (* DT 2.6)))
; )
😉 ; if
;(if (= I "L") (command ".TEXT" P0 DT "0" TM) (command ".TEXT" I P0 DT "0" TM))
;--------------------------------- Release 11 ---------------------------------
(progn (setq I "ML" P3 (polar P2 0.0 (* DT 2)) P0 (polar P2 0.0 (* DT 2.5))))
(progn (setq I "MR" P3 (polar P2 A (* DT 2)) P0 (polar P2 A (* DT 2.5))))
) ; if
(command ".LINE" P1 P2 P3 "" ".TRIM" C1 "" P1 "" ".TEXT" I P0 DT "0" TM
".TEXT" "M" P4 (* DT 1.5) "0" (strcat "%%U" TM)
".TEXT" "M" P5 DT "0" ET
)
(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.")
(C:DETAILS)


[Donald857HY]

I have this that should do what you ask.

(defun C:DETAIL1 ( / P1 EN EL PTS SS1)
(cond
;;Set up AutoCAD system variables
((DETAIL_0)
(prompt "\nError in DETAIL_0"))
;;
;;Operator input of detail center
;;and radius.
((DETAIL_1) ;;set up EL, P1, RD
(prompt "\nError in DETAIL_1"))
;;
;;Operator input of detail graphic location
;;and scale for detail display.
;;Copy detail area, remove non-detail objects
;;like dimensions and text, and scale as
;;input by the operator.
((DETAIL_2) ;;set up P2, SS1, EN, ENT, SCL
(prompt "\nError in DETAIL_2"))
;;
;;Do the trimming of the detail display.
((DETAIL_3)
(prompt "\nError in DETAIL_3"))
;;
;;Create the text tag and draw connecting
;;line between original area and detail
;;area.
((DETAIL_4) ;;Output text tag
(prompt "\nError in DETAIL_4"))
('T (prompt "\nDetail finished okay."))
)
;;
;;Reset system variables
(mapcar '(lambda (X)
(setvar (car X) (cadr X))) SYSVAR_LIST)
(prompt "\nUse TRIM to complete if needed.")
(princ)
)
;;-----------------------------------------------
;; Listing 2: Set up system variables
;;-----------------------------------------------
(defun DETAIL_0 ()
(setq SYSVAR_LIST (mapcar '(lambda (X)
(list X (getvar X)))
'("CMDECHO"
"OSMODE"
"ORTHOMODE"
"HIGHLIGHT"
)))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(setvar "ORTHOMODE" 0)
(setvar "HIGHLIGHT" 0)
(if (zerop (getvar "TILEMODE")) ;;make sure we are mspace
(if (= (getvar "CVPORT") 1) (progn ;;we are in paper space!
(alert "You must be in Model Space for this routine to function!")
(exit) ;;hard abort!
))
)
(if (zerop (getvar "WORLDUCS"))
(command "_UCS" "_W"))
nil
)
;;-----------------------------------------------
;; Listing 3: Establish area to detail
;;-----------------------------------------------
(defun DETAIL_1 ()
(setq P1 (getpoint "\nDetail center: "))
(if P1 (progn
(prompt "\nShow detail area: ")
(command "_CIRCLE" P1 pause)
(setq EN (entlast)
EL (entget EN)
RD (if (= (cdr (assoc 0 EL)) "CIRCLE")
(cdr (assoc 40 (entget EN)))
nil)
)
(if RD (progn
(entdel EN)
(command "_POLYGON" 15 P1 "I" RD)
(setq EN (entlast)
EL (entget EN)
)
nil ;return nil
)
1 ;return error level 1.
) ;;level 1 is RD not set
)
2 ;;return error level 2.
) ;level 2 is P1 not set
)
;;-----------------------------------------------
;; Listing 4: Copy objects to new location
;;-----------------------------------------------
(defun DETAIL_2 ()
(while (setq TMP (assoc 10 EL))
(setq EL (cdr (member TMP EL))
PTS (cons (cdr TMP) PTS)
)
)
(entdel EN)
(setq SS1 (ssget "CP" PTS)
P2 (getpoint P1 "\nPut detail at: ")
CNT (if SS1 (sslength SS1) 0)
)
(if P2 (progn
(repeat CNT
(if (member
(cdr (assoc 0
(entget
(ssname
SS1
(setq CNT (1- CNT))))))
;'("TEXT" "DIMENSION"
; "MTEXT" "INSERT"
; )
'("MTEXT")
)
(ssdel (ssname SS1 CNT) SS1)
)
)
(command "_CIRCLE" P1 RD
"_CIRCLE" P2 RD)
(setq EN (entlast)
ENT EN)
(command "_COPY" SS1 "" P1 P2)
(setq SS1 (ssadd EN))
(while (setq ENT (entnext ENT))
(ssadd ENT SS1)
)
(setq SCL (getreal "\nScale factor (2): "))
(if (null SCL) (setq SCL 2.0))
(if (/= SCL 1.0)
(command "_SCALE" SS1 "" P2 SCL)
)
nil ;;return nil result, all okay.
)
1 ;;return error code 1
) ;;error code, P2 not input.
)
;;-----------------------------------------------
;; Listing 5: Trim the objects copied
;;-----------------------------------------------
(defun DETAIL_3 ()
(setq TTT 0) ;;change counter
(while (setq ENT (ssname SS1 0))
(ssdel ENT SS1)
(if (not (equal ENT EN)) (progn
(setq EL (entget ENT)
PT (DETAIL_3A EL)
)
(if (and PT
(> (distance P2 PT)
(+ 0.2 (* RD SCL))))
(progn
(setq TTT (1+ TTT))
(command "_TRIM" EN ""
(list ENT PT) "")
))
))
(DETAIL_3B) ;;loop again check
)
nil
)
;;-----------------------------------------------
;; Listing 6: Find point on object for trim
;;-----------------------------------------------
(defun DETAIL_3A (EL / TY)
(setq TY (cdr (assoc 0 EL)))
(cond
((= TY "LINE")
(if (> (distance (cdr (assoc 10 EL)) P2)
(distance (cdr (assoc 11 EL)) P2))
(cdr (assoc 10 EL))
(cdr (assoc 11 EL))
)
)
((= TY "ARC")
(setq PC (cdr (assoc 10 EL))
PR (cdr (assoc 40 EL))
PA (cdr (assoc 50 EL))
PB (cdr (assoc 51 EL))
)
(if (> (distance (polar PC PA PR) P2)
(distance (polar PC PB PR) P2))
(polar PC PA PR)
(polar PC PB PR)
)
)
((= TY "CIRCLE")
(setq PC (cdr (assoc 10 EL))
PR (cdr (assoc 40 EL))
)
(cond
((> (distance P2
(polar PC 0.0 PR))
(* RD SCL))
(polar PC 0.0 PR))
((> (distance P2
(polar PC PI PR))
(* RD SCL))
(polar PC PI PR))
((> (distance P2
(polar PC (* 0.5 PI) PR))
(* RD SCL))
(polar PC (* 0.5 PI) PR))
(t (polar PC (* 1.5 PI) PR))
)
)
((= TY "LWPOLYLINE")
(setq PR nil)
(while (and (null PR)
(setq PA (assoc 10 EL)))
(setq EL (cdr (member PA EL))
PA (cdr PA)
)
(if (> (distance P2 PA) (* RD SCL))
(setq PR PA)))
)
((= TY "SPLINE")
(setq PR nil)
(while (and (null PR)
(setq PA (assoc 11 EL))
EL (cdr (member PA EL))
PA (cdr PA))
(if (> (distance P2 PA) (* RD SCL))
(setq PR PA)))
)
((= TY "POLYLINE")
(setq EL (entget
(entnext
(cdr (assoc -1 EL))))
PR nil)
(while (and (null PR)
(= (cdr (assoc 0 EL))
"VERTEX"))
(setq PA (cdr (assoc 10 EL))
EL (entget
(entnext
(cdr (assoc -1 EL))))
)
(if (> (distance P2 PA)
(* RD SCL))
(setq PR PA)
)
)
)
;;add more objects here
) ;;end COND for PT assignment
)
;;-----------------------------------------------
;; Listing 7: Loop control options for user
;;-----------------------------------------------
(defun DETAIL_3B ()
(if (= (sslength SS1) 0)
(if (> TTT 0) (progn
(initget 0 "Yes No")
(setq TTT (getkword (strcat
"\nChanged "
(itoa TTT)
" objects, Loop again? <Yes>")))
(if (or (null TTT) (= TTT "Yes"))
(progn
(setq SS1 (ssadd EN)
ENT EN)
(while (setq ENT (entnext ENT))
(ssadd ENT SS1)
)
(setq TTT 0)
))
))
)
)
;;-----------------------------------------------
;; Listing 8: Finishing touches
;;-----------------------------------------------
(defun DETAIL_4 ()
(command "_TEXT"
"_Justify" "_Center"
(polar P2
(* PI 1.5)
(+ (* SCL RD)
(* 2.5
(getvar "TEXTSIZE"))))
)
(if (zerop (cdr (assoc 40
(tblsearch
"STYLE"
(getvar "TEXTSTYLE")))))
(command "") ;;text height output option
)
(command 0 ;;finish the TEXT command sequence.
(strcat "Enlarged "
(rtos SCL 2
(Best_Prec SCL 0 4))
"x")
)
;;
;; Construct line between detail circles.
;;
(command "_LINE" (polar P1 (angle P1 P2) RD)
(polar P2 (angle P2 P1) (* RD SCL))
"")
nil
)
;;-----------------------------------------------
;; Listing 9: Utility Routine from toolbox
;;-----------------------------------------------
;; Best_Prec - Given a number (NUM) and the
;; minimum and maximum precision, this function
;; returns the precision in the range that will
;; best fit the number.
;;
(defun Best_Prec (Num Mn Mx)
(while (and (<= Mn Mx)
(/= Num (atof (rtos Num 2 Mn))))
(setq Mn (1+ Mn))
)
Mn
)

---

@paul9ZMBV wrote:

Hi,

I would like a Lisp to enable me to draw a circle and and then it copies everything in the circle and then asks for a scale to enlarge it.

I have found a lisp online (below) and it kind of work, but seems to do other things after it has scaled it but i cant work out what the other features are, perhaps someone can read the lisp below and work it out please.

; 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:DETAILS (/ A E I L R DT EN ET HL OK TM C1 C2 S1 P0 P1 P2 P3 P4 P5)
(setq DT (* (getvar "DIMSCALE") (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 "\nDetail centerpoint: "))
(princ "\nEncircle detail: ") (command ".CIRCLE" P1 PAUSE)
(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 detail: ") (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) (* DT 2)) P5 (polar P4 (* A 1.5) (* DT 2))
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)))
;--------------------------------- Release 9 ----------------------------------
; (progn (setq I "L" P3 (polar P2 (- A pi) (* DT 2))
; P0 (polar P2 (- (* A 2) 0.167) (* DT 2.6)))
; )
; (progn
; (setq I "R" P3 (polar P2 A (* DT 2)) P0 (polar P2 (+ A 0.167) (* DT 2.6)))
; )
😉; if
;(if (= I "L") (command ".TEXT" P0 DT "0" TM) (command ".TEXT" I P0 DT "0" TM))
;--------------------------------- Release 11 ---------------------------------
(progn (setq I "ML" P3 (polar P2 0.0 (* DT 2)) P0 (polar P2 0.0 (* DT 2.5))))
(progn (setq I "MR" P3 (polar P2 A (* DT 2)) P0 (polar P2 A (* DT 2.5))))
) ; if
(command ".LINE" P1 P2 P3 "" ".TRIM" C1 "" P1 "" ".TEXT" I P0 DT "0" TM
".TEXT" "M" P4 (* DT 1.5) "0" (strcat "%%U" TM)
".TEXT" "M" P5 DT "0" ET
)
(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.")
(C:DETAILS)


---

[Sea-Haven]

Try this just does scale objects. NO circle but some one smarter than me will add Grrdraw circle. The repeat emaulates a circle if problems selecting increase the repeat value and change the pi10 to match its 1/2 the repeat.

(defun c:sclobj ( / pt1 pt2 lst rad ss)
(setq pt1 (getpoint "\nPick centre point "))
(setq pt2 (getpoint pt1 "\nPick outside point "))
(setq lst '() pi10 ( / pi 10.0)  ang (- ( / pi 10.0)))
(setq rad (distance pt1 pt2))
(repeat 20
(setq lst (cons (polar pt1 (setq ang (+ ang pi10)) rad) lst))
)
(setq lst (cons (last lst) lst))
(setq ss (ssget "WP" lst ))
(if (= ss nil)
(princ "selection failed ")
(command "scale" ss "" pt1 (getreal "\nEnter scale factor "))
)
(princ)
)