Jump to content

lisp routine not working:


cadmando-2

Recommended Posts

  • 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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

  • 1 month later...
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
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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.

 

Link to comment
Share on other sites

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  

Link to comment
Share on other sites

(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
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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