Jump to content

Insert circles inside a polyline: improve code


MastroLube

Recommended Posts

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

LsjqPZe.png

Link to comment
Share on other sites

  • Replies 34
  • Created
  • Last Reply

Top Posters In This Topic

  • MastroLube

    14

  • ronjonp

    11

  • BIGAL

    6

  • rlx

    2

Top Posters In This Topic

Posted Images

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

 

 

max-frank_Shearail-punching-shear-reinforcement_Images_Image363.jpg

Link to comment
Share on other sites

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

 

 

max-frank_Shearail-punching-shear-reinforcement_Images_Image363.jpg

 

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by GP_
Link to comment
Share on other sites

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 :oops:

Link to comment
Share on other sites

  • 1 month later...
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

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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 by MastroLube
Link to comment
Share on other sites

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 by marko_ribar
Link to comment
Share on other sites

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 by MastroLube
Link to comment
Share on other sites

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 by ronjonp
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...