Jump to content

routine detail ...help

leonucadomi

By leonucadomi
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

leonucadomi Rising Star

leonucadomi

Posted
Posted

hello all:

I use a code that allows me to make a detail

I just wanted to make some changes.

I want the detail to always be scale 1 and not ask me about the scale

and the other thing is that it deactivates my isnap at the end of the program :(

can someone help me about this

thanks.

here code 

; DET.LSP   Enlarge an Area for a Detail   (c)1992, Victor V. Jensen
; -  Modified for Release 11.
; [DET.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:DET (/ 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)
 (command ".ERASE" C1 "")
 (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))
 )
(command "_REGENALL" "")

 ;(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 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.")

 

GLAVCVS Community Regular

GLAVCVS

Posted
Posted (edited)

Check if it works.
I don't have a PC in front of me so I edited it from my smartphone.

  

; DET.LSP   Enlarge an Area for a Detail   (c)1992, Victor V. Jensen
; -  Modified for Release 11.
; [DET.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:DET (/ 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)
        osmant (getvar "osmode") 
 )
 (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)
 (command ".ERASE" C1 "")
 (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))
 )
(command "_REGENALL" "")

 ;(setvar "HIGHLIGHT" 0)
 (initget 6)
 ;(if (setq HL (getreal "\nScale factor <1.0000>: "))


  (command ".SCALE" "C" P2 P3 "" P4 (setq HL 1.0))
 ;)
 (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 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)
(setvar "osmode" osmant) 
 (princ)
) ; end program
(princ "loaded.")

 

Basically:
-it was necessary to save the state of the variable 'OSNAP' and restore it at the end
-the part of the code where the scale is requested has been cancelled and the value 1.0 has been assigned directly

Edited by GLAVCVS
  • Thanks 1
leonucadomi Rising Star

leonucadomi

Posted
  • Author
Posted
57 minutes ago, GLAVCVS said:

Check if it works.
I don't have a PC in front of me so I edited it from my smartphone.

  

; DET.LSP   Enlarge an Area for a Detail   (c)1992, Victor V. Jensen
; -  Modified for Release 11.
; [DET.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:DET (/ 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)
        osmant (getvar "osmode") 
 )
 (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)
 (command ".ERASE" C1 "")
 (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))
 )
(command "_REGENALL" "")

 ;(setvar "HIGHLIGHT" 0)
 (initget 6)
 ;(if (setq HL (getreal "\nScale factor <1.0000>: "))


  (command ".SCALE" "C" P2 P3 "" P4 (setq HL 1.0))
 ;)
 (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 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)
(setvar "osmode" osmant) 
 (princ)
) ; end program
(princ "loaded.")

 

Basically:
-it was necessary to save the state of the variable 'OSNAP' and restore it at the end
-the part of the code where the scale is requested has been cancelled and the value 1.0 has been assigned directly

WORKS VERY WELL, THANKS

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...