Jump to content

Recommended Posts

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

 

Posted

Scale: Look through the code, there will be a line containing the command line text asking for scale, something like "Scale Factor " - search for that (you don't need the full text, just enough). Probably there will be a variable, lets call it HL - if you want that to be fixed replace the (get....... ) function with a number (setq HL 1)

 

For the snaps, there will be something like (setvar 'OSNAP 0), which will turn off snaps, if you want them to always be on at the end then before the 'End program' line turn them on setting 'OSNAP to 1 by the same method. A smarter way is before the 'OSNAP 0  line do something like (setq OSNAP_Old (getvar 'OSNAP)) and instead of 1 at the reset line, use something like (setvar 'OSNAP OSNAP_Old)... sets it to as it was before - snaps on or off

Posted

Noting that this is a double post, 1 hour apart. Most of the CAD guys on here work for a living, got to give them chance to answer, single posts of a question are usually good enough and the answer will come as and when we get chance

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.

×
×
  • Create New...