[编程交流] 在多段线内插入圆

(defun dcer ( / *error* passo Dcon Dcon* dmax p_or d2 p L1 L2 Lc cont tot e1 ret EL EL* LIN n Lc del)
   
;   richiesta distanza dal contorno   
;*************************************
   (setq Rd 2)    
;*************************************
   
   (setq olderr *error* *error* myerror_**)
   
   (m_v (list "cmdecho" "hporigin" "hpbound" )) ;estrare le variabili e ne fa una lista (("cmdecho".0) ("hporigin" . ...) ..)
  ;hporigin Imposta il punto di origine del tratteggio per i nuovi modelli di tratteggio rispetto all'UCS corrente.
  ;Controlla il tipo di oggetto creato dai comandi TRATTEGGIO e CONTORNI. 0 Regione 1 polilinea
   
   (setvar 'cmdecho 0)
   (command "_.undo" "_begin")
   (prompt "\n ") (prompt "\n ")
 (IF (= "S" (substr (dcl-Control-GetText Cobiax/Main/tipo_alleggerimento) 1 1))
   (progn
   (setq diam (substr (dcl-Control-GetText Cobiax/Main/tipo_alleggerimento) 7 3))
   (cond
       ( (= diam "315") (setq passo (* scala 0.35)) )
   )
   )
   (progn
     (setq diam (substr (dcl-Control-GetText Cobiax/Main/tipo_alleggerimento) 3 3))
   (cond
       ( (= diam "315") (setq passo (* scala 0.35)) )
       ( (= diam "360") (setq passo (* scala 0.40)) )
       ( (= diam "405") (setq passo (* scala 0.45)) )
       ( (= diam "450") (setq passo (* scala 0.50)) )
       
       )
     )
   )
 (IF (= "D" (substr (dcl-Control-GetText Cobiax/Main/tipo_alleggerimento) 1 1))
   (progn
     (setq diam "315"
           passo (* scala 0.365))
     )
   )
   
   (setq Dcon (/ passo 2.)) ;raggio della sfera?
   (setq Dcon* (* scala 1000.0)  )  
   (setq p_or (getpoint "\nOrigine Campitura ")) ;punto origine campitura
   (setq d2 (* scala (/ (atof diam) 2000.0))) ;boh?!
   (setq p_or (mapcar '+ p_or (list Dcon Dcon 0.0))) ;sposto il punto dal vertice all'interno così da avere una sfera interna
   (setq p (getpoint "\nPunto Interno "))
 
   
   (setvar 'hporigin p_or) ;setta l'origine della capitura al punto individuato
   (setvar 'hpbound 1)     ;Controlla il tipo di oggetto creato dai comandi TRATTEGGIO e CONTORNI. 0 Regione 1 polilinea
  
   (setq LIN (ssadd))
   (setq tot (ssadd))
   (setq EL* (entlast))
   (_CreateLayer "Bordi" 253 "" 0 0)
   (setq OLD_LAYER (getvar 'clayer))
   (_SetCLayer "Bordi")
   (sblocca_layers)
;;;    (command "_-bhatch" "_L" "Bordi" "_a" "_r" "_y" "_i" "_y" "" "_p" "_u" "0" passo "_y" p "" )
    (command "_-bhatch" "_a" "_r" "_y" "_i" "_y" "" "_p" "_u" "0" passo "_y" p "" ) ;acad 2009
   (_SetCLayer OLD_LAYER)
   ;(setq P_linea (entlast))
   (while EL*
       (if (setq EL* (entnext EL*)) (ssadd EL* tot))        
   )
   (repeat (setq n (sslength tot))
       (setq e1 (ssname tot (setq n (1- n))))
       (if (= (cdr (assoc 0 (entget e1))) "HATCH")
           (setq ret e1)
           (setq cont (cons e1 cont))
       )
   )
   (setq EL (entlast))     
   (command "_explode" ret)
   
   (setq LIN (ssadd))
   (while EL
       (if (setq EL (entnext EL)) (ssadd EL LIN))        
   ) ;seleziona le linee
   ;gruppo di selezione -> lista 
   (repeat  (setq n (sslength LIN))
       (setq L1 (cons (ssname LIN (setq n (1- n))) L1))
   )
   (setq L2 L1)
  
   (mapcar
       '(lambda (a)
            (mapcar
                '(lambda (b)
                     (ii a b)
                 )
                 (setq L2 (cdr L2))
            )
        )
       L1
   )
   (vl-cmdf "._erase" LIN "")
   (setq EL (entlast))
   (setq lista_cerchi (list))
   (mapcar
       '(lambda (x)
          (setq lista_cerchi (append lista_cerchi (list
            (ENTMAKEX (LIST
                       '(0 . "CIRCLE")
                        (cons 8 nome) ;layer
                 
                       (cons 62 (atoi colore))
                       (CONS 10 x)
                       (CONS 40 d2)))
            )))
        )
        Lc 
   )
)    
;*************************************************************************
(defun m_v (va)
   (setq varsis '())
   (repeat (length va)
       (setq varsis (append varsis
                            (list (cons (car va) (getvar (car va))))
                    )
       )
       (setq va (cdr va))
   )
)
;*************************************************************************
(defun r_v ()
   (repeat (length varsis)
       (setvar (caar varsis) (cdar varsis))
       (setq varsis (cdr varsis))
   )
)
;*************************************************************************
(defun ii (ent1 ent2 / int )
   (setq ent1 (vlax-ename->vla-object ent1))
   (setq ent2 (vlax-ename->vla-object ent2))
   (setq int (vlax-invoke ent1 'IntersectWith ent2 acExtendNone))
   (cond (int
        (repeat (/ (length int) 3)
            (setq Lc (cons (list (car int)(cadr int)(caddr int)) Lc))
            (setq int (cdddr int))
        )
    )
   )
)
;*************************************************************************
(defun listavertici ( poly / list_vert)
   (mapcar '(lambda (x)
                (if (eq (car x) 10)
                    (setq list_vert (cons (trans (list (cadr x) (caddr x)) 0 1) list_vert))
                )
            )
            (entget poly)
   )
   list_vert
)

I did manually all the steps in a new lisp that has not been coded yet.
circle
array circle
chprop wp picked the inside points and changed layer
layiso outside circles and erased
unlayiso 
all done.
Ps arcs can be taken into account by making facets when doing Chprop WP to increase accuracy.

; get circles with closed pline example
; By Alan H july 2018
; program starts here
(defun objectswithin ( / obj pt i co-ords xy co-ordsxy rad spc ll ur xmany ymany ss )
(setq obj (vlax-ename->vla-object (car (entsel "\nplease pick pline"))))
(vla-getboundingbox obj 'll 'ur)
(setq ll(vlax-safearray->list ll))
(setq ur (vlax-safearray->list ur))
(setq co-ords (vlax-safearray->list(vlax-variant-value (vlax-get-property     obj     "Coordinates" ))))
(setq I 0)
(repeat(/ (length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
(setq pt (getpoint "Pick circle point"))
(setq rad (getreal "Enter radius"))
(setq spc (getreal "Enter spacing"))
(if (not(tblsearch "layer" "tempcircle1") )
(command "-layer" "M" "tempcircle1" "c" 6 "tempcircle1" "")
)
(if (not (tblsearch "layer" "tempcircle2") )
( command "-layer" "M" "tempcircle2" "c" 2 "tempcircle2" "")
)
(setq oldlay (getvar 'clayer))
(setvar 'clayer "tempcircle1")
(setq ll (list (- (car ll) rad) (- (cadr ll) rad)))
(setq ur (list (+ (car ur) rad) (+ (cadr ur) rad)))
(setq xmany   (fix (/ (- (car ur)(car ll)) spc)))
(setq ymany   (fix(/ (- (cadr ur)(cadr ll)) spc)))
(command  "circle" ll rad)
(setq  obj2 (entlast))
(command "-array"  obj2 ""  "R" ymany xmany spc spc )
; selection set of circles within polygon
(setq ss (ssget "WP" co-ordsxy (list (cons 0 "Circle")))) 
(princ (sslength ss)) ; this is howmany Circles
(command "chprop" ss "" "la" "tempcircle2" "")
(command "layiso" obj2 "")
(command "erase" "w" (getvar 'extmin)(getvar 'extmax) "")
(command "layuniso" )
(setvar 'clayer oldlay)
)
(objectswithin)