Insert Block on Multiple Circles (Circle Center Point)

[ELIANDEFI]

Hi All,

Could anyone help me create a LISP for Inserting Block on Multiple Circles (Circle Center Point).

Note:

Insertion of a Block to Circle Center Point

Thank you in advance.

[Tharwat]

Hi,
Add your block name in the program below as indicated in the codes and this should work with regular blocks and not with attributed blocks, because attributed blocks require more codes to fill out the values based on the blocks' settings.



(defun c:Test (/ int sel ent bkn)
;;----------------------------------------------------;;
;; Author : Tharwat Al Choufi ;;
;; website: https://autolispprograms.wordpress.com ;;
;;----------------------------------------------------;;

(setq bkn "MyBlock") ;; Replace MyBlock with your correct name.

(and (or (tblsearch "BLOCK" bkn)
(alert (strcat "Block Name < " bkn " > was not found !"))
)
(princ (strcat "\nSelect circles to position < "
bkn
" > over them : "
)
)
(setq int -1
sel (ssget '((0 . "CIRCLE")))
)
(while (setq int (1+ int)
ent (ssname sel int)
)
(entmake (list '(0 . "INSERT")
(cons 2 bkn)
(assoc 10 (entget ent))
'(41 . 1.0)
'(42 . 1.0)
'(43 . 1.0)
)
)
)
)
(princ)
)

[peter]

More structured code using ActiveX and only copying (instead of inserting) selected block without keyboard entry.



;___________________________________________________________________________________________________________|
;
; Command Line Function to Copy a block on centers of selection set of circles
;___________________________________________________________________________________________________________|

(defun C:BOC ()(C:BlockOnCircle))

(defun C:BlockOnCircle (/ lstCircleObjects objBlock ssBlock ssCircles)
(if (and (princ "\nSelect Block: ")
(setq ssBlock (ssget ":S:E" (list (cons 0 "insert"))))
(setq objBlock (car (SelectionSetToList ssBlock)))
(princ "\nSelect Circles: ")
(setq ssCircles (ssget (list (cons 0 "circle"))))
(setq lstCircleObjects (SelectionSetToList ssCircles))

)
(CopyBlockToCircleCenters objBlock lstCircleObjects)
)
)

;___________________________________________________________________________________________________________|
;
; Function to Copy a block only centers of a list of circles objects using activeX
;___________________________________________________________________________________________________________|

(defun CopyBlockToCircleCenters (objBlock lstCircleObjects / lstCircleObjects lstInsertionPoint objCircle )
(if (setq lstInsertionPoint (vlax-get objBlock "insertionpoint"))
(foreach objCircle lstCircleObjects
(setq lstCircleCenterPoint (vlax-get objCircle "center"))
(setq objBlockNew (vlax-invoke objBlock "copy"))
(vlax-invoke objBlockNew "move" lstInsertionPoint lstCircleCenterPoint)
)
)
)

;___________________________________________________________________________________________________________|
;
; Function to convert a lisp selection set to a list of vla objects
;___________________________________________________________________________________________________________|

(defun SelectionSetToList (ssSelections / entSelection intCount lstObjects objSelection )
(repeat (setq intCount (sslength ssSelections))
(and
(setq intCount (1- intCount))
(setq entSelection (ssname ssSelections intCount))
(setq objSelection (vlax-ename->vla-object entSelection))
(setq lstObjects (cons objSelection lstObjects))
)
)
(reverse lstObjects)
)

(vl-load-com)

[ELIANDEFI]

Hi Peter

This is exactly what I needed.

Thank you for always spending time to help!

Regards

- - - Updated - - -

Hi Tharwat

I got what I'm needed but I always appreciated the time you spend to help me.

Regards

[v.hari87811529]

Thank you:)

[devitg.89838]

@peter Please check it, from your post.


;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;;************************************************************************************************************
;;----------------------------------------------------------------------;;
;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;; Copyleft 1995-2024 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM
;;

; Hecho por Gabo CALOS DE VIT de CORDOBA ARGENTINA
;;; Copyleft 1995-2024 por Gabriel Calos De Vit
;; DEVITG@GMAIL.COM
;;; inicio-defun-12-03-2024

;;;;-*******************************************************************************************************************************



(defun blk-@-circle-center (/ ACAD-OBJ
ADOC CIRCLE-CENTER
LSTCIRCLEOBJECTS
OBJBLOCK OBJBLOCK-CPY
OBJBLOCK-CPY-CTR
SSBLOCK SSCIRCLES ;_ end of ACAD-OBJ
)
(VL-LOAD-COM)
(SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD
(SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
;; By PETER at Augi forum
(if (and (princ "\nSelect Block: ")
(setq ssBlock (ssget ":S:E" (list (cons 0 "insert"))))
(setq objBlock (vla-item (VLA-GET-ACTIVESELECTIONSET adoc) 0))
(princ "\nSelect Circles: ")
(setq ssCircles (ssget (list (cons 0 "circle"))))
(setq lstCircleObjects (VLA-GET-ACTIVESELECTIONSET adoc))
) ;_ end of and
(princ)
) ;_ end of if
;;https://forums.augi.com/showthread.php?176874-Insert-Block-on-Multiple-Circles-(Circle-Center-Point)
(vlax-for Circle-Obj lstCircleObjects
(setq circle-center (VLA-GET-CENTER Circle-Obj))
(setq objBlock-cpy (VLA-COPY objBlock))
(setq objBlock-cpy-ctr (VLA-GET-INSERTIONPOINT objBlock-cpy))
(vla-Move objBlock-cpy objBlock-cpy-ctr circle-center)
) ;_ end of vlax-for
) ;_ end of defun

(defun C:blk@circ ()

(blk-@-circle-center)

)



Thanks for your part