Detail circle in MS

[jim78b]

i have this code but it don't work i expected.

It details with a callout line but does not create a new block by drawing it in the circle.

(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
)

 

[Emmanuel Delay]

Could you describe what you want the script to do?

[jim78b]

I said it above, I want it to do what the posted lisp does but have the circle detail cut out the extra parts.

[Steven P]

So the circle will trim all the entities within it?

[SLW210]

Like a wipeout or solid hatch?

[jim78b]

[Emmanuel Delay]

Oh, you want to see a detail in a bigger scale.

My first idea: 

Put a circular viewport in paper space and give it double/triple/... scale.

https://thecadgeek.com/blog/creating-circular-viewports/

[jim78b]

1 hour ago, Emmanuel Delay said:

Oh, you want to see a detail in a bigger scale.

My first idea: 

Put a circular viewport in paper space and give it double/triple/... scale.

https://thecadgeek.com/blog/creating-circular-viewports/

sorry i work in model space, i mean in model space

[Steven P]

Apart from this LISP, you might find modelling everything in modelspace and setting up the drawing in paperspace so much more versatile. 

 

For your problem above a viewport in paperspace makes sense, then any changes to the detail will be reflected in the viewport rather than having to recreate the detail block.

[SLW210]

Do you have access to AutoCAD Mechanical?

 

AutoCAD Mechanical 2023 Help | To Create a Detail View in Model Space and Place a Copy in a Layout (AutoCAD Mechanical Toolset) | Autodesk

 

 

[Steven P]

Try this as a starter:

 

Only a small amount of testing but it should create a block from entities within a selected circle - might not trim to every entity though./

 

You can then scale the block as necessary and add the call out lines manually (can do that with LISP if you think this will work).

 

A couple of things to modify within the LISP to make it work better. Note as it is you cannot re-use a block name - got to add a check later to make that work

 

Note can be a bit slow, it used BEdit to work, I could use refedit which will be quicker I think

 

(defun c:Detail1 ( / MyCircle CircleOrigin CircleRadius MyPoly MySS MyBlock)
  (defun mAssoc ( key lst / result ) ;;https://www.cadtutor.net/forum/topic/27914-massoc-implementations/
    (foreach x lst
      (if (= key (car x))
        (setq result (cons (cdr x) result))
      )
    )
    (reverse result)
  )

;; Variables
  (setq PolyVertex 50)

;; Function
  (princ "Clip area. Please ")                ;;Select a circle. Loop till circle selected or escape
  (while (not (equal (assoc 0 (setq MyCircle (entget (car (entsel "select circle")) ))) '(0 . "CIRCLE")) )
    (princ "\n That's not a circle, please ") ;;If circle not selected
  )
  (setq CircleOrigin (cdr (assoc 10 MyCircle)))
  (setq CircleRadius (cdr (assoc 40 MyCircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" CircleRadius) ;; polyline approximation of selected circle. Amend '50' for accuracy
  (setq MyPoly (entlast))                     ;; Grab 'circle' polygon entity
;;TO DO: Zoom to polygon
  (setq MyPolyPoints (mAssoc 10 (entget MyPoly)))
  (command "erase" MyPoly "")                 ;; Delete 'circle' polygon entity
;;TO DO: zoom previous zoom
  (setq MySS (ssget "_CP" MyPolyPoints))      ;; Select everything within circle
  (command "_.copybase" "_non" CircleOrigin MySS "" ) ;; Copy to clipboard

  (princ "\nInsert Block")
  (command "_.pasteblock" pause)              ;; Paste snip as a block
  (setq MyBlock (entlast))                    ;; Grab the block
  (princ "\nWhat's your block name? ")        ;; Rename the block
  (setq NewName (getstring))                  ;; Enter the new block name for cut out
  (setq OldName (cdr (assoc 2 (entget MyBlock) )))
;;TO DO: Check here if block name exists
  (command "rename" "b" OldName NewName)

;;Now lets edit the block
  (command "_.Bedit" NewName)
  (setq BlockCircle (ssget "_X" (list (cons 0 "CIRCLE")(cons 40 CircleRadius))))
  (setq ACircle (entget (ssname BlockCircle 0)))
  (setq CircleOrigin (cdr (assoc 10 ACircle)))
  (setq CircleRadius (cdr (assoc 40 ACircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" CircleRadius) ;; polyline approximation of selected circle. Amend '50' for accuracy
  (setq APoly (entlast))                     ;; Grab 'circle' polygon entity
;;TO DO: Zoom to polygon should be zoomed anyway
  (setq APolyPoints (mAssoc 10 (entget APoly)))
  (command "erase" APoly "")                 ;; Delete 'circle' polygon entity

  (setq APolyPoints (append APolyPoints (list (last APolyPoints))))
  (setq acount 0)
  (while (< acount PolyVertex)               ;; Trim to polyline (circle approximation)
    (setq p1 (nth acount APolyPoints))
    (setq p2 (nth (+ acount 1) APolyPoints))
    (if (equal p1 p2)
      (progn)
      (command "_.trim" BlockCircle "" "f" p1 p2 "" "")
    )
    (setq acount (+ acount 1))
  ) ; end while
  (command "_.bsave")
  (command "_.Bclose")

  (princ)
)

 

Edited June 19 by Steven P

[jim78b]

4 hours ago, SLW210 said:

Do you have access to AutoCAD Mechanical?

 

AutoCAD Mechanical 2023 Help | To Create a Detail View in Model Space and Place a Copy in a Layout (AutoCAD Mechanical Toolset) | Autodesk

 

 

NO

[jim78b]

51 minutes ago, Steven P said:

Try this as a starter:

 

Only a small amount of testing but it should create a block from entities within a selected circle - might not trim to every entity though./

 

You can then scale the block as necessary and add the call out lines manually (can do that with LISP if you think this will work).

 

A couple of things to modify within the LISP to make it work better. Note as it is you cannot re-use a block name - got to add a check later to make that work

 

Note can be a bit slow, it used BEdit to work, I could use refedit which will be quicker I think

 

(defun c:Detail1 ( / MyCircle CircleOrigin CircleRadius MyPoly MySS MyBlock)
  (defun mAssoc ( key lst / result ) ;;https://www.cadtutor.net/forum/topic/27914-massoc-implementations/
    (foreach x lst
      (if (= key (car x))
        (setq result (cons (cdr x) result))
      )
    )
    (reverse result)
  )

;; Variables
  (setq PolyVertex 50)

;; Function
  (princ "Clip area. Please ")                ;;Select a circle. Loop till circle selected or escape
  (while (not (equal (assoc 0 (setq MyCircle (entget (car (entsel "select circle")) ))) '(0 . "CIRCLE")) )
    (princ "\n That's not a circle, please ") ;;If circle not selected
  )
  (setq CircleOrigin (cdr (assoc 10 MyCircle)))
  (setq CircleRadius (cdr (assoc 40 MyCircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" CircleRadius) ;; polyline approximation of selected circle. Amend '50' for accuracy
  (setq MyPoly (entlast))                     ;; Grab 'circle' polygon entity
;;TO DO: Zoom to polygon
  (setq MyPolyPoints (mAssoc 10 (entget MyPoly)))
  (command "erase" MyPoly "")                 ;; Delete 'circle' polygon entity
;;TO DO: zoom previous zoom
  (setq MySS (ssget "_CP" MyPolyPoints))      ;; Select everything within circle
  (command "_.copybase" "_non" CircleOrigin MySS "" ) ;; Copy to clipboard

  (princ "\nInsert Block")
  (command "_.pasteblock" pause)              ;; Paste snip as a block
  (setq MyBlock (entlast))                    ;; Grab the block
  (princ "\nWhat's your block name? ")        ;; Rename the block
  (setq NewName (getstring))                  ;; Enter the new block name for cut out
  (setq OldName (cdr (assoc 2 (entget MyBlock) )))
;;TO DO: Check here if block name exists
  (command "rename" "b" OldName NewName)

;;Now lets edit the block
  (command "_.Bedit" NewName)
  (setq BlockCircle (ssget "_X" (list (cons 0 "CIRCLE")(cons 40 CircleRadius))))
  (setq ACircle (entget (ssname BlockCircle 0)))
  (setq CircleOrigin (cdr (assoc 10 ACircle)))
  (setq CircleRadius (cdr (assoc 40 ACircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" CircleRadius) ;; polyline approximation of selected circle. Amend '50' for accuracy
  (setq APoly (entlast))                     ;; Grab 'circle' polygon entity
;;TO DO: Zoom to polygon should be zoomed anyway
  (setq APolyPoints (mAssoc 10 (entget APoly)))
  (command "erase" APoly "")                 ;; Delete 'circle' polygon entity

  (setq APolyPoints (append APolyPoints (list (last APolyPoints))))
  (setq acount 0)
  (while (< acount PolyVertex)               ;; Trim to polyline (circle approximation)
    (setq p1 (nth acount APolyPoints))
    (setq p2 (nth (+ acount 1) APolyPoints))
    (if (equal p1 p2)
      (progn)
      (command "_.trim" BlockCircle "" "f" p1 p2 "" "")
    )
    (setq acount (+ acount 1))
  ) ; end while
  (command "_.bsave")
  (command "_.Bclose")

  (princ)
)

 

Thanks for take me time, but don't work after i select a circle give me: Insert Block_.pasteblock . i draw a circle on my blocks.
 

[Steven P]

OK , are you able to post a sample drawing?

 

 

EDIT:

Just checking where the LISP fails, do you get to place the block - straight after the line Insert Block_.pasteblock you should see 'Specify Insertion Point' in the command line and the circled area under the mouse pointer to insert the block as you require.

 

Next you get the option to name the block as you want 'whats your block name?' - enter the block name in the command line

 

 

Try the code below so I can understand what is happening perhaps. All I've done is added notes to the command line as to where the LISP gets to while running ie. 'OK A' will tell me you have successfully selected a circle and so on.. if the LISP doesn't run fully scroll back up the command line to see the last 'OK n' statement - gives me a clue where it is stopping

 

 

(defun c:Detail1 ( / MyCircle CircleOrigin CircleRadius MyPoly MySS MyBlock)
  (defun mAssoc ( key lst / result ) ;;https://www.cadtutor.net/forum/topic/27914-massoc-implementations/
    (foreach x lst
      (if (= key (car x))
        (setq result (cons (cdr x) result))
      )
    )
    (reverse result)
  )

;; Variables
  (setq PolyVertex 50)

;; Function
  (princ "Clip area. Please ")                ;;Select a circle. Loop till circle selected or escape
  (while (not (equal (assoc 0 (setq MyCircle (entget (car (entsel "select circle")) ))) '(0 . "CIRCLE")) )
    (princ "\n That's not a circle, please ") ;;If circle not selected
  )

(princ "\nOK A")

  (setq CircleOrigin (cdr (assoc 10 MyCircle)))
  (setq CircleRadius (cdr (assoc 40 MyCircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" CircleRadius) ;; polyline approximation of selected circle. Amend '50' for accuracy
  (setq MyPoly (entlast))                     ;; Grab 'circle' polygon entity
;;TO DO: Zoom to polygon
  (setq MyPolyPoints (mAssoc 10 (entget MyPoly)))
  (command "erase" MyPoly "")                 ;; Delete 'circle' polygon entity

(princ "\nOK B")

;;TO DO: zoom previous zoom
  (setq MySS (ssget "_CP" MyPolyPoints))      ;; Select everything within circle
  (command "_.copybase" "_non" CircleOrigin MySS "" ) ;; Copy to clipboard

(princ "\nOK C")

  (princ "\nInsert Block")
  (command "_.pasteblock" pause)              ;; Paste snip as a block
  (setq MyBlock (entlast))                    ;; Grab the block

(princ "\nOK D")

  (princ "\nWhat's your block name? ")        ;; Rename the block
  (setq NewName (getstring))                  ;; Enter the new block name for cut out
  (setq OldName (cdr (assoc 2 (entget MyBlock) )))
;;TO DO: Check here if block name exists
  (command "rename" "b" OldName NewName)

(princ "\nOK E")

;;Now lets edit the block
  (command "_.Bedit" NewName)

(princ "\nOK F")

  (setq BlockCircle (ssget "_X" (list (cons 0 "CIRCLE")(cons 40 CircleRadius))))
  (setq ACircle (entget (ssname BlockCircle 0)))
  (setq CircleOrigin (cdr (assoc 10 ACircle)))
  (setq CircleRadius (cdr (assoc 40 ACircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" CircleRadius) ;; polyline approximation of selected circle. Amend '50' for accuracy
  (setq APoly (entlast))                     ;; Grab 'circle' polygon entity

(princ "\nOK G")

;;TO DO: Zoom to polygon should be zoomed anyway
  (setq APolyPoints (mAssoc 10 (entget APoly)))
  (command "erase" APoly "")                 ;; Delete 'circle' polygon entity

(princ "\nOK H")

  (setq APolyPoints (append APolyPoints (list (last APolyPoints))))
  (setq acount 0)
  (while (< acount PolyVertex)               ;; Trim to polyline (circle approximation)
    (setq p1 (nth acount APolyPoints))
    (setq p2 (nth (+ acount 1) APolyPoints))
    (if (equal p1 p2)
      (progn)
      (command "_.trim" BlockCircle "" "f" p1 p2 "" "")
    )
    (setq acount (+ acount 1))
  ) ; end while
  (command "_.bsave")
  (command "_.Bclose")

(princ "\nOK I")

  (princ)
)

 

Edited June 19 by Steven P

[jim78b]

16 hours ago, Steven P said:

OK , are you able to post a sample drawing?

 

 

EDIT:

Just checking where the LISP fails, do you get to place the block - straight after the line Insert Block_.pasteblock you should see 'Specify Insertion Point' in the command line and the circled area under the mouse pointer to insert the block as you require.

 

Next you get the option to name the block as you want 'whats your block name?' - enter the block name in the command line

 

 

Try the code below so I can understand what is happening perhaps. All I've done is added notes to the command line as to where the LISP gets to while running ie. 'OK A' will tell me you have successfully selected a circle and so on.. if the LISP doesn't run fully scroll back up the command line to see the last 'OK n' statement - gives me a clue where it is stopping

 

 

(defun c:Detail1 ( / MyCircle CircleOrigin CircleRadius MyPoly MySS MyBlock)
  (defun mAssoc ( key lst / result ) ;;https://www.cadtutor.net/forum/topic/27914-massoc-implementations/
    (foreach x lst
      (if (= key (car x))
        (setq result (cons (cdr x) result))
      )
    )
    (reverse result)
  )

;; Variables
  (setq PolyVertex 50)

;; Function
  (princ "Clip area. Please ")                ;;Select a circle. Loop till circle selected or escape
  (while (not (equal (assoc 0 (setq MyCircle (entget (car (entsel "select circle")) ))) '(0 . "CIRCLE")) )
    (princ "\n That's not a circle, please ") ;;If circle not selected
  )

(princ "\nOK A")

  (setq CircleOrigin (cdr (assoc 10 MyCircle)))
  (setq CircleRadius (cdr (assoc 40 MyCircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" CircleRadius) ;; polyline approximation of selected circle. Amend '50' for accuracy
  (setq MyPoly (entlast))                     ;; Grab 'circle' polygon entity
;;TO DO: Zoom to polygon
  (setq MyPolyPoints (mAssoc 10 (entget MyPoly)))
  (command "erase" MyPoly "")                 ;; Delete 'circle' polygon entity

(princ "\nOK B")

;;TO DO: zoom previous zoom
  (setq MySS (ssget "_CP" MyPolyPoints))      ;; Select everything within circle
  (command "_.copybase" "_non" CircleOrigin MySS "" ) ;; Copy to clipboard

(princ "\nOK C")

  (princ "\nInsert Block")
  (command "_.pasteblock" pause)              ;; Paste snip as a block
  (setq MyBlock (entlast))                    ;; Grab the block

(princ "\nOK D")

  (princ "\nWhat's your block name? ")        ;; Rename the block
  (setq NewName (getstring))                  ;; Enter the new block name for cut out
  (setq OldName (cdr (assoc 2 (entget MyBlock) )))
;;TO DO: Check here if block name exists
  (command "rename" "b" OldName NewName)

(princ "\nOK E")

;;Now lets edit the block
  (command "_.Bedit" NewName)

(princ "\nOK F")

  (setq BlockCircle (ssget "_X" (list (cons 0 "CIRCLE")(cons 40 CircleRadius))))
  (setq ACircle (entget (ssname BlockCircle 0)))
  (setq CircleOrigin (cdr (assoc 10 ACircle)))
  (setq CircleRadius (cdr (assoc 40 ACircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" CircleRadius) ;; polyline approximation of selected circle. Amend '50' for accuracy
  (setq APoly (entlast))                     ;; Grab 'circle' polygon entity

(princ "\nOK G")

;;TO DO: Zoom to polygon should be zoomed anyway
  (setq APolyPoints (mAssoc 10 (entget APoly)))
  (command "erase" APoly "")                 ;; Delete 'circle' polygon entity

(princ "\nOK H")

  (setq APolyPoints (append APolyPoints (list (last APolyPoints))))
  (setq acount 0)
  (while (< acount PolyVertex)               ;; Trim to polyline (circle approximation)
    (setq p1 (nth acount APolyPoints))
    (setq p2 (nth (+ acount 1) APolyPoints))
    (if (equal p1 p2)
      (progn)
      (command "_.trim" BlockCircle "" "f" p1 p2 "" "")
    )
    (setq acount (+ acount 1))
  ) ; end while
  (command "_.bsave")
  (command "_.Bclose")

(princ "\nOK I")

  (princ)
)

 

 

EX DETAIL.dwg

[Emmanuel Delay]

Just to show the viewports solution ...

EX DETAIL.dwg

[Steven P]

Your example here works for me as it should, I didn't realise that the detail was a block so there needs to be a little change to the code to account for that. I'll see what I can do today

[jim78b]

9 minutes ago, Steven P said:

Your example here works for me as it should, I didn't realise that the detail was a block so there needs to be a little change to the code to account for that. I'll see what I can do today

YES I mean a block, can you modify the code please? thanks a lot

[Steven P]

Try this version, if it works OK I'll tidy it up the code

 

As before, no call out lines, just the circles.

 

(defun c:Detail1 ( / PolyVertex MyCircle CircleOrigin CircleRadius MyPoly
                     MyPolyPoints MySS MyBlock NewName OldName BlockCircle
                     ACircle APoly APolyPoints Obj1 Obj2 pnt acount AllBock
                 )
;;Sub functions
  ;;Massoc: Return values from key number in dotted pairs list eg. Entities
  (defun mAssoc ( key lst / result ) ;;https://www.cadtutor.net/forum/topic/27914-massoc-implementations/
    (foreach x lst
      (if (= key (car x))
        (setq result (cons (cdr x) result))
      )
    )
    (reverse result)
  )

  ;;Intersections between 2 entities
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
  )

  ;;Delete union of 2 selection sets/ lst: (Big set, Set to delete) 
  (defun LM:ss-union ( lst / ss i out ) https://www.cadtutor.net/forum/topic/39716-how-to-join-selection-sets/
    (setq lst (vl-sort lst '(lambda ( a b ) (> (sslength a) (sslength b))))
          out (car lst)
    )
    (foreach ss (cdr lst)
      (repeat (setq i (sslength ss))
        (ssdel (ssname ss (setq i (1- i))) out) ;; Change to SSADD to union selection sets.
      )
    )
    out
  )
;; End of sub functions

;; Variables
  (setq PolyVertex 60)                        ;; Number of verticies for circle approximation

;; Function
  (princ "Clip area. Please ")                ;;Select a circle. Loop till circle selected or escape
  (while (not (equal (assoc 0 (setq MyCircle (entget (car (entsel "select circle")) ))) '(0 . "CIRCLE")) )
    (princ "\n That's not a circle, please ") ;;If circle not selected
  )
  (setq CircleOrigin (cdr (assoc 10 MyCircle)))
  (setq CircleRadius (cdr (assoc 40 MyCircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" (+ CircleRadius 0.001)) ;; polyline approximation of selected circle.
  (setq MyPoly (entlast))                     ;; Grab 'circle' polygon entity

;;TO DO: Zoom to polygon

  (setq MyPolyPoints (mAssoc 10 (entget MyPoly))) ;; Get list of polyline (polygon) points
  (command "erase" MyPoly "")                 ;; Delete 'circle' polygon entity

;;TO DO: zoom previous zoom

  (setq MySS (ssget "_CP" MyPolyPoints))      ;; Select everything within circle
  (command "_.copybase" "_non" CircleOrigin MySS "" ) ;; Copy to clipboard

  (princ "\nInsert Block")
  (command "_.pasteblock" pause)              ;; Paste clipboard as a block
  (setq MyBlock (entlast))                    ;; Grab the block
  (princ "\nWhat's your block name? ")        ;; Rename the block
  (setq NewName (getstring T))                ;; Enter the new block name for cut out. T: Allow for spaces
  (setq OldName (cdr (assoc 2 (entget MyBlock) )))

;;TO DO: Check here if block name exists

  (command "rename" "b" OldName NewName)      ;; Do the rename. Entmake faster but command is simpler

;;Now lets edit the block
  (command "_.Bedit" NewName)                 ;; Open block editor
  (command "_.EXPLODE" (ssget "_X"))          ;; Explode all blocks

  (setq BlockCircle (ssget "_X" (list (cons 0 "CIRCLE")(cons 40 CircleRadius)))) ;; Select the circle
  (setq ACircle (entget (ssname BlockCircle 0)))
  (setq CircleOrigin (cdr (assoc 10 ACircle)))
  (setq CircleRadius (cdr (assoc 40 ACircle)))
  (command "_polygon" PolyVertex "_non" CircleOrigin "C" (+ CircleRadius 0.001)) ;; polyline approximation of selected circle.
  (setq APoly (entlast))                     ;; Grab 'circle' polygon entity

;;TO DO: Zoom to polygon should be zoomed anyway

  (setq APolyPoints (mAssoc 10 (entget APoly))) ;; Get list of polyline (polygon) points
  (command "erase" APoly "")                 ;; Delete 'circle' polygon entity

  (setq MySS (ssget "_CP" APolyPoints))      ;; Select everything within circle
  (if MySS                                   ;; If there was anything selected
    (progn
      (setq acount 0)                        ;; A counter
      (setq obj2 (ssname BlockCircle 0))
      (while (< acount (sslength MySS))
        (setq obj1 (ssname MySS acount))     ;; Obj1 is the crossing entity
        (foreach pnt (LM:intersections (vlax-ename->vla-object obj1) (vlax-ename->vla-object obj2) acextendnone)

          (command "breakatpoint" obj1 pnt)  ;; Break the entity at the crossing point.
;; Breakatpoint fails here if entity crosses twice, inc circles and ellipses
;; Make list of points for not circles, then loop through to break at points

        ) ; end foreach
        (setq acount (+ acount 1))
      ) ; end while                          ;; End while loop
    ) ; end progn
  ) ; end if MySS

  (setq AllBlock (ssget "_X"))              ;; Select everything
  (setq MySS (ssget "_WP" APolyPoints))     ;; Select everything within circle
  (setq DeleteSS (LM:ss-union (list AllBlock MySS))) ;; Delete MySS from AllBlock selection sets
  (command "erase" DeleteSS "" )            ;; Delete everything outside the circle

  (command "_.bsave")
  (command "_.Bclose")

  (princ)
)

 

Edited June 20 by Steven P

[BIGAL]

@Steven P just a suggestion, take the circle and use it via polygon to select all objects within, CP, then copy the objects to clipboard,  use bedit, paste objects  use Extrim or cookiecutter to trim to circle.  May need a second select circle in bedit ,save block. Can then insert anywhere.

 

I just did manually and was reasonably quick.

 

Will see if can find time to do it as lisp.

Edited June 20 by BIGAL