Lisp to automatically draw rectangles where it intersects with specific points

Hi there folks, i work in a company that manufactures models for buildings.

And i work specific in the drawing sector, where i use AutoCad to draw the pieces for the models.

In our line of work we constantly have to draw "maps" to the people who take the pieces and put them all together to form the model

I have already developed several lisp routines to ease my work, and now i'm currently trying to ease (a lot) the making of these maps.

so what i need right now is:

1) a way to sort points in a list of points, so that they will be in order from the closest to the furthest in relation to a base point

2) the amount of points will always be different so, how can i store these points in succession? (like point1 being the closest and point10 being the furthest if there are 10 points in the list)

3) before sorting the points (or after) remove the points that are too close from each other (like, if point2 is 0.02 units distant from point3, disregard point3)

and all of this is to be able to automatically detect the position of windows and doors in the middle of a wall and mark them in the map without having to manually find them

here's my code so far (it asks for the espessure of the material used in the model, the number of the wall in the map, and the height of the text to place the number of the wall in the map)

P.S i'm a very amateur programmer, if so

(defun c:md ()
(setq layercorrente (getvar 'clayer))
(defun dtr (a) (* Pi (/ a 180.0)))
(defun rtd (b) (* b (/ 180.0 Pi)))
(setvar "OSNAPCOORD" 1)
(setq esp (getdist "\nDigite a espessura da parede <enter = ultima espessura>: "))
(if (= esp nil) (setq esp esptemp))
(setq esptemp esp)
(setq altura_texto (getdist "\nInsira a altura do texto <enter = ultima altura>:"))
 (cond 
   ((and (= altura_texto nil) (= altura_textotemp nil)) (setq altura_texto esp)
   )
   ((and (= altura_texto nil) (/= altura_textotemp nil)) (setq altura_texto altura_textotemp)
   )
 )
(setq numero (getint "Indique o numero da próxima parede <enter = ultimo numero de parede>:"))
 (cond
   ((and (= numero nil) (= numero_old nil))
   (setq numero 1)
   )
   ((and (= numero nil) (/= numero_old nil))
   (setq numero numero_old)
   )
 )
(setq numero_old numero)
(setq texto (itoa numero))
(command "_-style" "loks" "txt" altura_texto "1" "" "" "" "")
(setq rotation 0)
(setq ponto1 (getpoint "\nInsira o primeiro ponto de inserção da parede levando em conta o sentido anti-horário:"))
(setq ponto2 (getpoint "\nInsira o segundo ponto de inserção:"))
(setq comprimento (distance ponto1 ponto2))
(setq ang1 (angle ponto1 ponto2))
(setq ang2 (rtd ang1))
(setq ang3 (+ ang2 90.0))
(if (>= ang3 360.0) (setq ang3 (- ang3 360)))
(setq ang4 (+ ang2 270.0))
(if (>= ang4 360.0) (setq ang4 (- ang4 360)))
(setq ponto3 (polar ponto2 (dtr ang3) esp))
(setq ponto4 (polar ponto1 (dtr ang3) esp))
(setq pontoref (polar ponto1 ang1 (/ comprimento 2)))
(cond
 ((<= 0 ang4 105) (setq pontotxt (polar pontoref (dtr ang4) (* 1.5 altura_texto)))
 )
 ((and (< 105 ang4 255) (<= 0 numero 9)) (setq pontotxt (polar pontoref (dtr ang4) (* 2 altura_texto)))
 )
 ((and (< 105 ang4 255) (<= 10 numero 99)) (setq pontotxt (polar pontoref (dtr ang4) (* 2.5 altura_texto)))
 )
 ((and (< 105 ang4 255) (<= 100 numero)) (setq pontotxt (polar pontoref (dtr ang4) (* 3.4 altura_texto)))
 )
 ((<= 255 ang4 300) (setq pontotxt (polar pontoref (dtr ang4) (* 2 altura_texto)))
 )
 ((< 300 ang4 360) (setq pontotxt (polar pontoref (dtr ang4) (* 1.5 altura_texto)))
 )
)
(defun c:mapadeparedes ()
(setvar 'clayer layercorrente)
(command "pline" ponto1 ponto2 ponto3 ponto4 "c")
(command "LAYER" "M" "-TEXTO_DECORADO" "C" "42" "" "")
(command "text" pontotxt rotation texto)
(setvar 'clayer layercorrente)
)
(c:mapadeparedes)
(while (/= ponto1 nil)
(setq ponto1 (getpoint "\nInsira o primeiro ponto de inserção da parede levando em conta o sentido anti-horário:"))
 (cond
   ((/= ponto1 nil)
(setq ponto2 (getpoint "\nInsira o segundo ponto de inserção:"))
(setq comprimento (distance ponto1 ponto2))
(setq ang1 (angle ponto1 ponto2))
(setq ang2 (rtd ang1))
(setq ang3 (+ ang2 90.0))
(if (>= ang3 360.0) (setq ang3 (- ang3 360)))
(setq ang4 (+ ang2 270.0))
(if (>= ang4 360.0) (setq ang4 (- ang4 360)))
(setq ponto3 (polar ponto2 (dtr ang3) esp))
(setq ponto4 (polar ponto1 (dtr ang3) esp))
(setq pontoref (polar ponto1 ang1 (/ comprimento 2)))
(cond
 ((<= 0 ang4 105) (setq pontotxt (polar pontoref (dtr ang4) (* 1.5 altura_texto)))
 )
 ((and (< 105 ang4 255) (<= 0 numero 9)) (setq pontotxt (polar pontoref (dtr ang4) (* 2 altura_texto)))
 )
 ((and (< 105 ang4 255) (<= 10 numero 99)) (setq pontotxt (polar pontoref (dtr ang4) (* 2.5 altura_texto)))
 )
 ((and (< 105 ang4 255) (<= 100 numero)) (setq pontotxt (polar pontoref (dtr ang4) (* 3.4 altura_texto)))
 )
 ((<= 255 ang4 300) (setq pontotxt (polar pontoref (dtr ang4) (* 2 altura_texto)))
 )
 ((< 300 ang4 360) (setq pontotxt (polar pontoref (dtr ang4) (* 1.5 altura_texto)))
 )
)
(setq numero (+ numero 1))
(setq texto (itoa numero))
(c:mapadeparedes)
   )
 )
)
(setq numero_old (+ numero 1))
)
(princ "\nDIGITE MD PARA DESENHAR O MAPA DE PAREDES DE DECORADO MAIS FACILMENTE.")
(princ)

Hi,

Simple example of sorting a list of points relative to a certain point:

(setq org '(0. 0. 0.)
     pts '((9. 8. 0.) (7. 6. 0.) (1. 2. 0.) (3. 4. 0.))
     )

(vl-sort pts '(lambda (a b) (< (distance org a) (distance org b))))

Solution for step #3 (Lee Mac's LM:UniqueFuzz subfunction).

Performed attempt anyway (without looking at his code) and ended up with:

; _$ (UQpL 0.01 '(1.0 1.1 2.0 2.01 2.2)) >> (1.0 1.1 2.0 2.2)
; _$ (UQpL 0.15 '(1.0 1.1 2.0 2.01 2.2)) >> (1.0 2.0 2.2)
(defun UQpL ( fuzz pL )
 ((lambda (f) (f pL fuzz))
   (lambda (pL fuzz / v)
     (if pL 
       (cons 
         (setq v (car pL))
         (f ((lambda (pL) (vl-remove-if (function (lambda (x) (equal v x fuzz))) pL)) (cdr pL)) fuzz)
       )
     )
   )
 )
); defun UQpL

Not sure will it be faster, since the tail recursion stores 'v' and doesn't try to access the car of the point list within the vl-remove-if.

Doing the same with a straight recursion - thats quite an achievement demonstrated by Lee.

thanks for both Tharwhat and Grrr u guys helped a lot!

In the end i only used Tharwhat's solution, because i solved the other problems by reaching the same goal by means of alternative methods.

Nevertheless, more knowledge is never enough, so thanks again =)

Now my routine is almost complete, the only ting i would really need is a more effective way to verify if a specified layer is contained within a selection set

Right now i'm isolating the specified layer and if the selection set is empty, this means a return nil, otherwise T, but it consumes a lot o time because this process is repeated many times

So, is there a way to find if there is at least one object, of a specified layer within a selection set?

Here's the most direct way:

(ssget '((8 . "yourlayername")))

Or if you already have items selected and converted to a list of enames:

(vl-some '(lambda (x) (wcmatch (cdr (assoc 8 (entget x))) "LAYERNAME")) listofenames)

Here's the most direct way:

(ssget '((8 . "yourlayername")))

 

Or if you already have items selected and converted to a list of enames:

(vl-some '(lambda (x) (wcmatch (cdr (assoc 8 (entget x))) "LAYERNAME")) listofenames)

thanks ronjop!

For the specific case the first code is enough, but the latter will also be quite useful! =)

I'll just leave the topic opened for the case that anything comes up again, but i think that for now i'm set!

(P.S i have posted my code earlier, if anyone could analyze it to verify if i'm "coding right", like... if there's a more effective way to do the same thing i'm already doing, the code is a bit extense, but if anyone have a little free time i would appreciate it)

Hi there folks, in trying to continue to improve my lisp routine i'm wondering if there's a way i can determine a pattern of objects to be found, and then quantify them in a selection set... like... i determine i want to find 2 vertical lines, measuring 0.1, and 0.1 distant from each other in X, then i select a bunch of objects and want the code to return to me teh amount of objects found in these patters i specified earlier in thgis selection

P.S i want to specify the pattern also by selection set, not by numeric parameters

it 's not possible?

Post a drawing of your example selection set .. I'm lost on what you're trying to do.

hi ronjonp, thanks for your reply!

in this image u can see a fragment of a blueprint where there's a window

i developed a routine that automatically identifies windows in a drawing and marks them with a rectangle, what i want now is to specify a selection pattern, like those 2 rectangles marked in the image, and trace them inside a slection set to count how many times they appear

if i manage to do that, i'll be able to determine not only where the windows are, but also how many leaves that window has (in this case it'll detect 2 selection patterns inside the window, so it will know that the window has 3 leaves)

i'm brazilian, so forgive me if i'm not too comprehensive

i'm sorry, the image follows:

http://ap.imagensbrasil.org/image/nq2YIG

Are your windows not blocks?

they are, but we have to explode them beforehand in order for my routine to work (the project comes from the client often with the wrong layer associated to a block, so we explode all blocks within a drawing

Yikes. Post a drawing before you've exploded it. I'm sure there's a better way to go about this.

ronjonp, i don't mean to sound rude, but i already thought about this, i examined the informations the blocks can give us and they don't provide any variable concerning the number of leaves in a window or door...

and even if they did provide info in this drawing there would be other drawings from different clients that would not provide them and we would be in the same impass

by being able to determine in every drawing a selection pattern, this would be solved, but i don't know how (if possible)

please, is there a way to do it? in the slightest chance?

I don't mean to sound rude, but post what I asked for and I'll help you if I can. If those small rectangles are closed polylines, just select all polylines on that layer ( assuming these drawings have some sort of organization ) and then filter your selection based on an area with a fuzz value.

ronjonp, since i'm not authorized to send a complete drawing would it be suffice if i isolated such blocks and attach them here?

if that works i'm already doing it, about the other thing you said it won't work because there are other polylines in the same layer that are not that specific rectangles, but as i said earlier, i'm sending to you the blocks...

blocks.dwg

what i want is similar to this http://www.kimprojects.com/count-rectangle-dimension-lisp/, but instead of a sheet indicating the lenght and width of every rectangle and their quantities, i just want to specify a selection pattern (for example 1 rectangle with 0.1 width and 0.1 length) and retrieve inside the code the amount of this pattern found in another selection set

Here's a quick one. Run it on your exploded blocks ( although if you just need counts, the code could do it without exploding ).

(defun c:foo (/ r o n)
 (cond	((and (setq o (car (nentsel "\nPick your little rectangle: ")))
      (setq o (vlax-ename->vla-object o))
      (vlax-property-available-p o 'area)
      (setq r (vla-get-area o))
      (setq n (ssadd))
 )
 (vlax-for a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
   (vlax-for b a
     (cond ((and (vlax-property-available-p b 'area) (equal (vla-get-area b) r 1e-2))
	    (ssadd (vlax-vla-object->ename b) n)
	    (vla-put-color b 1)
	   )
     )
   )
 )
 (sssetfirst nil n)
)
 )
 (princ)
)
(vl-load-com)