Jump to content
cadmando-2

lisp routine not working:

Recommended Posts

cadmando-2
Posted (edited)
  • I have used this "Detail.lsp" off and on for years now. and now for some reason it not working.

This detail.lsp would create scaled details.

Now it’s not working right!

  1. Creates the two detail circle, but no detail! Second it is showing in command line “Put detail at: Unknown command "DETAIL".  Press F1 for help.” Never done that.

  2. It has always made the scale lower caps “sCALE:”

 

(prompt "\nDETAIL
;;
;;
;;
;;
;; Detail enlargement macro set.
;;-----------------------------------------------
;; The Main Program
;;-----------------------------------------------
(defun C:DETAIL- ( / 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"
            )
          )
         (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 "\nSScale 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 "sCALED:"
                    (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
)


 

detail-.lsp

detail1.JPG

detail-scale.JPG

error.JPG

Edited by rkmcswain
added [CODE] tags

Share this post


Link to post
Share on other sites
Grrr
Posted (edited)

Quick glance on this...

Theres no closing double-quote, aswell a right-bracket in the first row: (prompt "\nDETAIL")

 

Also you might want to remove the dash "-" from here:

(defun C:DETAIL- ( / P1 EN EL PTS SS1)

Edited by Grrr

Share this post


Link to post
Share on other sites
cadmando-2
Posted (edited)

Ya,

The "-"

I copy and rename it so I wouldn't over right the original file.

Still having same error"😦

 

 

Code:

(prompt "\nDETAIL")
;;
;;
;;
;;
;; Detail enlargement macro set.
;;-----------------------------------------------
;; The Main Program
;;-----------------------------------------------
(defun C:DETAIL( / 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"
            )
          )
         (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 "\nSScale 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 "sCALED:"
                    (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
)


 

Edited by rkmcswain
added [CODE] tags

Share this post


Link to post
Share on other sites
cadmando-2
On ‎10‎/‎8‎/‎2018 at 12:07 PM, Grrr said:

Quick glance on this...

Theres no closing double-quote, aswell a right-bracket in the first row: (prompt "\nDETAIL") 

 

Also you might want to remove the dash "-" from here:

(defun C:DETAIL- ( / P1 EN EL PTS SS1)

 

GRRR

This works fine on other co-worker PC but myself and one other co-work, we get the same error and doesn't finish, but is blank in 2x center? confused.

and it keeps coming up "Detail" unknown command, but again works fine on one pc fine.

just can't figure it out...🙄 funny thing is, it worked at one time?

Edited by cadmando-2

Share this post


Link to post
Share on other sites
dlanorh

Just a hunch but try changing

 

(defun C:DETAIL( / P1 EN EL PTS SS1)

 to

 

(defun C:DETAIL ( / P1 EN EL PTS SS1)
              ^ ^
      insert a space here

 

Share this post


Link to post
Share on other sites
ronjonp

First thing I'd do is cleanup all those global variables ... 

; === Top statistic:
; Global variables: (SYSVAR_LIST X)
; Function definition (with number of arguments): ((C:DETAIL . 0))
.
; === Top statistic:
; Global variables: (SYSVAR_LIST X)
; Function definition (with number of arguments): ((DETAIL_0 . 0))
.
; === Top statistic:
; Global variables: (EL EN P1 PAUSE RD)
; Function definition (with number of arguments): ((DETAIL_1 . 0))
.
; === Top statistic:
; Global variables: (CNT EL EN ENT P1 P2 PTS RD SCL SS1 TMP)
; Function definition (with number of arguments): ((DETAIL_2 . 0))
.
; === Top statistic:
; Global variables: (EL EN ENT P2 PT RD SCL SS1 TTT)
; Function definition (with number of arguments): ((DETAIL_3 . 0))
.
; === Top statistic:
; Global variables: (P2 PA PB PC PR RD SCL)
; Function definition (with number of arguments): ((DETAIL_3A . 1))
.
; === Top statistic:
; Global variables: (EN ENT SS1 TTT)
; Function definition (with number of arguments): ((DETAIL_3B . 0))
.
; === Top statistic:
; Global variables: (P1 P2 RD SCL)
; Function definition (with number of arguments): ((DETAIL_4 . 0))
.
; === Top statistic:
; Function definition (with number of arguments): ((BEST_PREC . 3))
; Check done.

 

Share this post


Link to post
Share on other sites
CADTutor

@cadmando-2 is that version of detail.lsp now working as expected?

Share this post


Link to post
Share on other sites
Steven P
On ‎12‎/‎9‎/‎2018 at 9:41 AM, CADTutor said:

@cadmando-2 is that version of detail.lsp now working as expected?

 

It works for me

Share this post


Link to post
Share on other sites
cadmando-2

Still not working. can't figure it out. it works fine on co-workers AutoCAD Mechanical 2019, but on two of us on ACAD Mechanical 2018 not working.

it was at one time and didn't ACAD at all, not even service packs. it just doesn't finish and copy the object in the circle. and I even exploded the block to.

 

completely puzzled over it!  working 50 hour day now for 8 months and no extra time to sit down and figure it out. up against dead lines just no time and would be nice if it was working.

only change was "AutoCAD Mechanical 2018 WBLOCK Hotfix".

https://knowledge.autodesk.com/support/autocad-mechanical/getting-started/caas/screencast/Main/Details/92e3312b-aaa7-4fdd-8080-b77ca944b1c6.html  

Share this post


Link to post
Share on other sites
cadmando-2

made the changes suggested and still not working 

Share this post


Link to post
Share on other sites
ronjonp
(defun c:foo (/ _c ad b bd bn d e p p2 s sc)
  ;; RJP » 2018-12-10
  (defun _c (p r) (entmakex (list '(0 . "circle") (cons 10 p) '(8 . "detail") (cons 40 r))))
  (cond
    ((and
       (setq p (getpoint "\nPick center of detail: "))
       (setq d (getdist p "\nEnter radius: "))
       (setq p2 (getpoint p "\nPick point to place detail: "))
       (setq sc	(cond ((getint "\nEnter scale of detail <2>: "))
		      (2)
		)
       )
       (setq s (ssget "_C" (list (+ (car p) d) (- (cadr p) d)) (list (- (car p) d) (+ (cadr p) d))))
       (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
       (setq s (vl-remove-if
		 '(lambda (x) (wcmatch (cdr (assoc 0 (entget x))) "INSERT,MTEXT,TEXT,DIMENSION"))
		 s
	       )
       )
     )
     (setq bn (strcat "Detail_" (itoa sc) "_" (rtos (getvar 'cdate) 2 12)))
     (setq ad (vla-get-activedocument (vlax-get-acad-object)))
     (setq bd (vlax-invoke (vla-get-blocks ad) 'add p bn))
     (vlax-invoke ad 'copyobjects (mapcar 'vlax-ename->vla-object s) bd)
     (setq b (vla-insertblock (vla-get-modelspace ad) (vlax-3d-point p2) bn sc sc sc 0.))
     (_c p d)
     (_c p2 (* d sc))
     (vla-put-layer b "detail")
     (command "_.polygon" 100 p2 "_I" (* d sc))
     (setq e (entlast))
     (command "_.xclip" (vlax-vla-object->ename b) "" "_New" "_Select" e)
     (entdel e)
     (entmakex (list '(0 . "line")
		     (cons 10 (polar p (angle p p2) d))
		     (cons 11 (polar p (angle p p2) (- (distance p p2) (* d sc))))
		     '(8 . "detail")
	       )
     )
     (entmakex
       (list '(0 . "TEXT")
	     '(100 . "AcDbEntity")
	     '(67 . 0)
	     '(8 . "detail")
	     '(100 . "AcDbText")
	     (cons 10 (setq p2 (polar p2 (* pi 1.5) (+ (* d sc) (* 2.5 (getvar "TEXTSIZE"))))))
	     (cons 40 0.125)
	     (cons 1 (strcat "sCALED:" (itoa sc) "x"))
	     '(50 . 0.)
	     '(41 . 1.)
	     '(51 . 0.)
	     '(71 . 0)
	     '(72 . 1)
	     (cons 11 p2)
	     '(100 . "AcDbText")
	     '(73 . 0)
       )
     )
    )
  )
  (princ)
)
(vl-load-com)

I tried to somewhat translate your code. It could still use some cleanup but hopefully will give you a working base.

2018-12-10_15-24-22.gif

Edited by ronjonp
  • Like 1

Share this post


Link to post
Share on other sites
cadmando-2

Thanks ronjonp

I works. is there away to see the first circle.

I guess you could even change the circles to rectangle.

thank thank thank!

still would like to know what change on two PC that wouldn't allow the first detail.lsp not to work.

Thanks again

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×