Insert circles inside a polyline: improve code

July 2, 2018

Hi guys, I've found and modify an old code that fit my needs.

====================================================================================================

EDIT: GP_ has originally written the starting code. thanks for tolding me, I really didn't know it.

You can find the original code here:

http://www.cad3d.it/forum1/showthread.php?38359-Disegnare-cerchi-all-interno-di-un-polilinea/page2&p=319854#post319854

====================================================================================================

Unfortunately sometimes it's very slow..

I'm here to asking if there is a better way to accomplish that result

(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'm using OPENDCL so you can't run the code without some changes (I'll do them if needed).

The idea here is to create an hatch, explode it and insert a circle in the intersection points. If the circle cross a boundary line it will be deleted.

As you can see it's very slow...

Thanks for your help!

Dennis

Edited July 16, 2018 by MastroLube

July 2, 2018

What do those circles represent?

July 2, 2018

What do those circles represent?

Hello!

They represent the position of void former modules for lightweight reinforced concrete slabs.

July 2, 2018

Cool ..

July 2, 2018

Is your grid always at 0 rotation?

July 2, 2018

Is your grid always at 0 rotation?

Nope but i change the global UCS for other angles

July 3, 2018

A simple method select pline that represents the inner boundary use bpoly if required. Boundary box the pline choose a start point for what I used as the first circle location, in my case it was concrete panels, array in x and Y so it covers all of the pline, go slightly bigger than the pline, it is then very simple to clip/trim all the outside circles removing them, redo trim again this time any circles touching the pline get erased. This method was used on plines with arcs.

You need a bit of layer control so when doing trim don't wipe out something that should remain. It is very fast code was written originally like 20 years ago so pc were not that fast then. Its one bit of code I don't have as its copyrighted and I need to redo it anyway. I think I used chprop on objects that were found within poly "WP" so outside was like layer1 inside layer2 just del layer1 after change

I would also look at using UCS picking a side etc to orientate would be maybe more economical in ball placement.

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.

July 4, 2018

This is version 1 I have to add a few things and make faster, it just needs a pline to work, so if you have the objects in the image just use bpoly to make a internal pline that will be asked for note arcs are ok in a pline. Its a bit slow but I made a few thousand circles when testing. I need to add the control point correctly, I expect you would pick a side as a square off for the mesh so do Bpoly and UCS OB before running. Needs a trans function ver 2.

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

July 4, 2018

Had to blink a couple of times (with my eyes) how does it work , but then the light went on :-) Probably more roads to Rome but I think you did a great job Bigal!

July 5, 2018

Working on the UCS version now, as its concrete with reinforcement, there would be an edge that you start with, the other item is that you nominate the starting point for the circles, in the image above you have say reo at 200x200, a ball then every 200mm so need a start point that defines the grid pattern. Also looking at entmake as array is very slow and not sure why compared to manual. Found a hiccup that bounding box must be translated in a UCS. Found the code for translate and its very long. So looking at just using a min-max routine on the pline instead as it will work within the current UCS.

July 5, 2018

Nice idea BIGAL .. now you need to account for islands .

July 5, 2018

HERE's a quick stab at it using an exploded net hatch ( lines ) and other objects that are NOT lines. Not sure about speed but works with islands.

Definitely not that fast:

Command:

Command: QS

Filter by [blockName/Entity/Layer/Xdata] : l

Select object to set layer [HATCH]:

Select items on layer VOID...

Number of objects in selection: 6382

Couple of tweaks

Command:

Command: QS

Filter by [blockName/Entity/Layer/Xdata] : l

Select object to set layer [VOID]:

Select items on layer VOID...

Number of objects in selection: 26516

Edited July 5, 2018 by ronjonp

July 5, 2018

Maybe were doing it wrong and need to look at a hatch pattern of circles or not actually circles but facets if you zoom in. Will look into this.

July 5, 2018

Maybe were doing it wrong and need to look at a hatch pattern of circles or not actually circles but facets if you zoom in. Will look into this.

wouldn't a hatch pattern potentially leave you with partial circles at the boundaries? But if that's ok...

July 10, 2018

WOW GUYS!!!!!

You're doing a very good work here!!!

If appreciated I'll go a little bit in deep about this in order to have a full understanding of the problem

These elements can not be placed anywhere but only in areas where the shear strength of the floor is not exceeded.

These areas can be seen in the example and are those outside the green line. In cyan with the grey hatch you can see the supports of the slab and also above them you can not obviously put them. My code somehow takes it into account (sometimes it fails) just by creating the hatch. Perhaps an idea could be to create an hatch and use its boundary as a polyline instead of selecting it?

Anyway it's 50x faster then mine

Edited July 10, 2018 by MastroLube

July 10, 2018

I think it may be a couple of extra steps involved Bpoly will make plines of every shape within an enclosed area so it would put balls every where in the random shape including I take it the squiggly green line as the limit rather than the blue rectangs then second step would be select all green wiggles inside big polygon and repeat the ball trimming. Is that whats wanted or am I not understanding correct.

July 10, 2018

Hello Bigal!

Thanks for the explanation. Sound very cool that extra steps of Bpoly could do the trick!

Unfortunately green lines are not a polyline and usually it's on an XREF. It's what comes out of my fem (AxisVM).

Anyway yes, it's exactly what i'm dreaming for

Thanks for your help BIGAL

July 10, 2018

WOW GUYS!!!!!
You're doing a very good work here!!!

If appreciated I'll go a little bit in deep about this in order to have a full understanding of the problem

These elements can not be placed anywhere but only in areas where the shear strength of the floor is not exceeded.

These areas can be seen in the example and are those outside the green line. In cyan with the grey hatch you can see the supports of the slab and also above them you can not obviously put them. My code somehow takes it into account (sometimes it fails) just by creating the hatch. Perhaps an idea could be to create an hatch and use its boundary as a polyline instead of selecting it?

Anyway it's 50x faster then mine

Can you post that DWG?

July 10, 2018

Yes sure!

text cad tutor - Standard.zip

July 10, 2018

Here's what I have so far .. perhaps you can tune it to your needs.

(defun c:foo (/ _dxf a e el l1 l2 l3 p1 p2 q r s x y)
 ;; Not very fast ( 25 seconds ) with example because of the 3500 lines for "DIAG_FORZE_SUPERF"
 ;; Needs a grid of lines on 'hatch' layer and other objects to check proximity to
 (defun _dxf (c e) (cdr (assoc c (entget e))))
 ;; Circle radius
 (setq r 0.1575)
 (cond
   ;; A selection
   ((and (setq s (ssget '((0 . "*polyline,line,circle,ellipse"))))
  (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
    )
    ;; (idt_starttimer)
    (foreach x	s
      (setq el (entget x))
      (if (and (= "LINE" (_dxf 0 x)) (= "HATCH" (strcase (_dxf 8 x))))
 (progn	(setq q (angle (setq p1 (cdr (assoc 10 el))) (setq p2 (cdr (assoc 11 el)))))
	(or a (setq a (rem (angle (cdr (assoc 10 el)) (cdr (assoc 11 el))) pi)))
	(if (equal (rem q pi) a 1e-
	  (setq l1 (cons (list p1 p2) l1))
	  (setq l2 (cons (list p1 p2) l2))
	)
 )
 (setq l3 (cons x l3))
      )
    )
    (and
      l1
      l2
      l3
      (foreach	y l1
 (foreach z (vl-remove 'nil
		       (mapcar '(lambda (x) (inters (car x) (cadr x) (car y) (cadr y))) l2)
	    )
   (setq e (entmakex (list '(0 . "circle") '(8 . "void") (cons 10 z) (cons 40 r))))
   (and	(vl-some '(lambda (x) (< (distance z (vlax-curve-getclosestpointto x z)) r)) l3)
	(entdel e)
   )
 )
      )
    )
    ;; (idt_endtimer)
   )
 )
 (princ)
)
(vl-load-com)

Sign In

Insert circles inside a polyline: improve code

Recommended Posts

MastroLube

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

ronjonp

MastroLube

ronjonp

ronjonp

MastroLube

BIGAL

BIGAL

rlx

BIGAL

ronjonp

ronjonp

BIGAL

rlx

MastroLube

BIGAL

MastroLube

ronjonp

MastroLube

ronjonp

Join the conversation

Tutorials

Forums

Activity