Insert circles inside a polyline: improve code

July 10, 2018

Nice one!

How did you manage to make the hatch inside that? I'm trying with that file but it fails (this is a problem for my code as well)

If there is a secret please let me know

July 10, 2018

Maybe change HPGAPTOL to something larger? Also, why aren't there circles in these 2 places?

July 10, 2018

Maybe change HPGAPTOL to something larger? Also, why aren't there circles in these 2 places?

I've tried but still don't work.. I'm very unlucky with hatches ... :S

Because you have to make it simple for construction worker

Otherwise they will get mad placing all these balls.

Another reason could be the presence of punching reinforcement

July 10, 2018

I've tried but still don't work.. I'm very unlucky with hatches ... :S

Because you have to make it simple for construction worker

Otherwise they will get mad placing all these balls.

Another reason could be the presence of punching reinforcement

Cool .. it just stood out a bit since there isn't linework showing anything. It would be very difficult to write code to capture all scenarios without something to work with.

July 10, 2018

Cool .. it just stood out a bit since there isn't linework showing anything. It would be very difficult to write code to capture all scenarios without something to work with.

Yes you're right but I think it's very hard to get count of everything.. In my opinion getting circles out of the green lines and outside of walls/pillars and curbs is the best goal we can obtain

Removing some balls in a second time it's not a problem

July 10, 2018

Well if you can get the hatch to work, then my code should do an OK job

July 14, 2018

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

Why did you remove the author name from code?

; Disegno di una serie di cerchi all'interno di un'area chiusa
; La serie viene costruita parallela all'UCS corrente
; 02/09/2013 - Gian Paolo Cattaneo
;
; Discussione su CAD3D.IT
; http://www.cad3d.it/forum1/showthread.php?38359-Disegnare-cerchi-all-interno-di-un-polilinea/page2&p=319854#post319854

(defun c:dcer ( / *error* passo Dcon Dcon* dmax p_or d2 p L1 L2 Lc cont tot e1 ret EL EL* LIN n Lc del)
   

............code.................
............code.................
............code.................
............code.................
............code.................


(prompt "\n*") (prompt "\n*")
(princ "\n\\U+00AB  Disegno di cerchi all'interno di un'area chiusa - by Gian Paolo Cattaneo \\U+00BB")
(princ "\n\\U+00AB                  Digitare \"DCER\" per lanciare il Lisp                     \\U+00BB")
(princ)

Edited July 15, 2018 by GP_

July 16, 2018

Hi there, I didn't remove anything. I found part of this long time ago and that is how is saved on my pc :OOOO

I really didn't know the genius behind that. Anyway thanks I've learned a lot from this.. it was the beginning of everything

I'll edit the main post with that part then.

Ps.

if I had known, I would have come directly to that forum to ask questions in italian

August 20, 2018

On 7/10/2018 at 12:30 PM, BIGAL said:

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.

Hello BIGAL!

What do you think about this solution I've wrote in order to delete the circles inside the polylines?

  
(defun cancella_cerchi_interni ( / e i n s x vertici_pl)
(setq vertici_pl (cdrs 10 (entget (car (entsel "\nSeleziona polilinea")))))
    (if (setq s (ssget "_CP" vertici_pl  '((0 . "CIRCLE"))))
        (progn
            (setq i 0
                  n (sslength s)
            )
            (repeat n
                (setq e (ssname s i)
                      ;x (cdr (assoc 0 (entget e)))
                      i (1+ i)
                )
                (entdel e)
            )
        )
    )
    (princ)
)

0) I do the BPOLY to generate all the polylines I need.

1) I use your code to generate the balls (I've some troubles to make not global oriented circles)

2) I use mine to delete the inside polyline circles.

Any suggestion?

Thanks, Dennis

August 21, 2018

The CDRS needs something like this

; pline co-ords example
; By Alan H
(defun getcoords (ent)
  (vlax-safearray->list
    (vlax-variant-value
      (vlax-get-property
    obj
    "Coordinates"
      )
    )
  )
)
 
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq len (length co-ords))
(if (= (vla-get-objectname obj) "AcDbLwpolyline")
(setq numb (/ len 2)) ; even and odd check required
(setq numb (/ len 2)))

(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
; odd (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)

; program starts here
(setq obj (vlax-ename->vla-object (car (entsel "\nplease pick pline"))))
(setq co-ords (getcoords obj))
(co-ords2xy) ; list of 2d points making pline

August 21, 2018

Thank BIGAL, thank for your patience.. I'll try later.

Now I'm back to the ronjonp code in order to fix it

There was an error inside, I've tried to fix it but I'm not sure I did it in the correct way.. The problem was near the IF EQUAL part.

This is the version I've made right now. Unfortunately I was able to make it works only once

Thanks for your help!

Dennis

(DEFUN foo (/ _dxf a e el l1 l2 l3 p1 p2 q r s x y)
  (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)) (= "BORDI" (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-1)) ;problem was here!
             (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 . "DIMS") (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)
)


(defun C:test (/ p_or p Dcon)
(setq p_or (getpoint "\nOrigine Campitura ")) ;punto origine campitura
  (setq Dcon 0.35)
    
    (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
   

    (_CreateLayer "Bordi" 253 "" 0 0)
    (setq OLD_LAYER (getvar 'clayer))
    (_SetCLayer "Bordi")
    (command "_-bhatch" "_a" "_r" "_y" "_i" "_y" "" "_p" "_u" "0" Dcon "_y" p "" )
    (command "_explode" (entlast))
    (foo)
  )

On 7/10/2018 at 8:37 PM, ronjonp said:

Well if you can get the hatch to work, then my code should do an OK job

Edited August 21, 2018 by MastroLube

August 21, 2018

I think it is :

(if (equal (rem q pi) a 1e-6)
  (setq l1 (cons (list p1 p2) l1))
  (setq l2 (cons (list p1 p2) l2))
)

Something's wrong with Ron's posted code at that line, so I interpreted my way... I think your version is bad - you compare q and a - not (* a 1e-1)...

HTH., M.R.

Edited August 21, 2018 by marko_ribar

August 21, 2018

1 hour ago, marko_ribar said:
I think it is :
(if (equal (rem q pi) a 1e-6)
  (setq l1 (cons (list p1 p2) l1))
  (setq l2 (cons (list p1 p2) l2))
)
Something's wrong with Ron's posted code at that line, so I interpreted my way... I think your version is bad - you compare q and a - not (* a 1e-1)...

HTH., M.R.

Thanks! I'll try that.. I was studying this code but had some trouble to understand what happens at that point.. L3 contains external object (not from the hatch), L1 maybe "horizontal" lines and L2 "vertical" ? Need to study a little bit more :S

EDIT: yes this is the correct fix of the code! wow it takes like 3 second vs 15 second of the precedent code

Edited August 21, 2018 by MastroLube

August 21, 2018

Here are some comments to help you understand what is going on.

(defun c:foo (/ _dxf a e el l1 l2 l3 p1 p2 q r s x y)
  ;; RJP » 2018-08-21
  ;; 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))))
     )
     ;; Foreach entity in selection
     (foreach x	s
       ;; Get the entity list
       (setq el (entget x))
       ;; If it's a line and on layer hatch
       (if (and (= "LINE" (_dxf 0 x)) (= "HATCH" (strcase (_dxf 8 x))))
	 ;; Get the angle of the line
	 (progn	(setq q (angle (setq p1 (cdr (assoc 10 el))) (setq p2 (cdr (assoc 11 el)))))
		;; If 'a' has not been set yet, set it ( to separate angles )
		(or a (setq a (rem (angle (cdr (assoc 10 el)) (cdr (assoc 11 el))) pi)))
		(if (equal (rem q pi) a 1e-1)
		  ;; 'l1' is first angle found 'a'
		  (setq l1 (cons (list p1 p2) l1))
		  ;; 'l2' is any other angle
		  (setq l2 (cons (list p1 p2) l2))
		)
		;; 'l3' is all other objects in selection that are not lines on layer hatch
		(setq l3 (cons x l3))
	 )
       )
     )
     ;; And 'l1' 'l2' & 'l3' exist
     (and
       l1
       l2
       l3
       ;; Cycle through 'l1'
       (foreach	y l1
	 ;; Cycle through intersection points with 'l2'
	 (foreach z
		    (vl-remove 'nil
			       (mapcar '(lambda (x) (inters (car x) (cadr x) (car y) (cadr y))) l2)
		    )
	   ;; Create a circle at intersection point found
	   (setq e (entmakex (list '(0 . "circle") '(8 . "void") (cons 10 z) (cons 40 r))))
	   ;; If some object in 'l3' distance is less than the radius of the circle
	   (and	(vl-some '(lambda (x) (< (distance z (vlax-curve-getclosestpointto x z)) r)) l3)
		;; Delete the circle because it intersects
		(entdel e)
	   )
	 )
       )
     )
    )
  )
  (princ)
)
(vl-load-com)

Edited August 21, 2018 by ronjonp

August 21, 2018

Thank you ronjonp!!

I'll start to study it right now

In the meantime I've added some features.. Let me know if there is something I can make better

(DEFUN foo (/ _dxf a e el l1 l2 l3 p1 p2 q r s x y)
  (DEFUN _dxf (c e) (CDR (ASSOC c (ENTGET e))))
  ;; Raggio sfere
  (SETQ r 0.1575)
  (COND
    ;; A selection
    ((AND ;(SETQ s (SSGET '((0 . "*polyline,line,circle,ellipse"))))
          (Setq s (ssget "_A" '((0 . "*polyline,line,circle,ellipse") (8 . "Bordi"))))
          (SETQ s (VL-REMOVE-IF 'LISTP (MAPCAR 'CADR (SSNAMEX s))))
     )

     (FOREACH x s
       (SETQ el (ENTGET x))
       (IF (AND (= "LINE" (_dxf 0 x)) (= "BORDI" (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-6)
             (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 . "DIMS") (CONS 10 z) (CONS 40 r))
               )
           )
           (AND (VL-SOME '(LAMBDA (x)
                            (< (DISTANCE z (VLAX-CURVE-GETCLOSESTPOINTTO x z)) r)
                          )
                         l3
                )
                (ENTDEL e)
           )
         )
       )
     )

    )
  )
  
  (command "_erase" (ssget "_A" '((0 . "*polyline,line,circle,ellipse") (8 . "Bordi"))) "")
)


(defun C:test (/ p_or p Dcon)
(setq p_or (getpoint "\nOrigine Campitura ")) ;punto origine campitura
    (setq Dcon 0.35)
   
    (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
   

    (_CreateLayer "Bordi" 253 "" 0 0)
    (setq OLD_LAYER (getvar 'clayer))
    (_SetCLayer "Bordi")
    (command "_-bhatch" "_a" "_r" "_y" "_i" "_y" "" "_p" "_u" "0" Dcon "_y" p "" )
    (command "_explode" (entlast))
    (foo)
  )

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

MastroLube

ronjonp

GP_

MastroLube

MastroLube

BIGAL

MastroLube

marko_ribar

MastroLube

ronjonp

MastroLube

Join the conversation

Tutorials

Forums

Activity