Small Fish Posted May 7, 2009 Posted May 7, 2009 Hi I would like to find areas of circles in rows using ssget or otherwise. For example - say there are 3 circles on row and the center point y value are the same. Diameters can vary. Another row might have 2 circles and again center point y values are the same Another row might have 4 circles. What I would like to compute is the total areas for each row. So my final will have a total areas for the three different rows. (Three answers) What I have tried to do is in my code: 1)Make a selection set of all the circles 2)Make a filter finding a row with circles that have the same center point y value. 3)Process the circle row and find the total area of the circles for that row. 4)Delete that row from the selection set. 5)Move on to the next row and compute the total area for that row And so on until all the row areas have been computed. I have attempted to write something though it doesn't work. Maybe someone could rewrite to get it going? Thanks a bunch if you can crack this one! Here is my code: (defun c:RowAreas (/ js jsx js_new n dxf_ent new_js m new_xx areaobjn obj1 obj total) (vl-load-com) (setq jsx (ssget '((0 . "CIRCLE"))) js_new (ssadd)) (setq n (sslength jsx)) (setq dxf_ent (entget (ssname jsx (setq n (1- n)))));get entity list (setq test 1) (while ( (setq new_xx (ssget "_X" (list '(0 . "CIRCLE") '(-4 . "*,=,*") (assoc 10 dxf_ent)));same center of circle y value );setq (setq i 0) (setq total 0.0) (setq lenrow (sslength new_xx)) (setq obj (vlax-ename->vla-object (ssname new_xx i))) (setq areaobj (vla-get-area obj)) (setq total (+ total areaobj));total area of circles on same row (setq i (1+ i)) (ssdel js_new new_xx) );while (alert (rtos total)) (princ) ) Quote
wizman Posted May 7, 2009 Posted May 7, 2009 Please try: (defun c:RowAreas (/ areaobj dxf_ent i jsx jsx_ename jsx_ ename2 lenrow new_xx obj test total) (vl-load-com) (if (setq jsx (ssget "_X" '((0 . "CIRCLE")))) (progn (setq test 1) (while (not (zerop (sslength jsx))) (setq dxf_ent (entget (setq jsx_ename (ssname jsx 0)))) (setq new_xx (ssget "_X" (list '(0 . "CIRCLE") '(-4 . "*,=,*") (assoc 10 dxf_ent) ) ) ) (setq i 0) (setq total 0.0) (setq lenrow (sslength new_xx)) (while (< i lenrow) (setq obj (vlax-ename->vla-object (setq jsx_ename2 (ssname new_xx i)))) (setq areaobj (vla-get-area obj)) (setq total (+ total areaobj)) (setq i (1+ i)) (ssdel jsx_ename2 jsx) ) (princ (strcat "Row " (itoa test) ";" " Y = " (rtos (caddr (assoc 10 dxf_ent))) " => " (rtos total) "\n" ) ) (ssdel jsx_ename jsx) (setq test (1+ test)) ) (textscr) ) ) (princ) ) Quote
Lee Mac Posted May 7, 2009 Posted May 7, 2009 Pretty cool Wizman, never knew you could use: (-4 . "*,=,*") As a way of filtering Quote
Small Fish Posted May 7, 2009 Author Posted May 7, 2009 Hey Thanks Wizman! Thats great! I now want to modify it so that it does more processing in the "while" loop. So I may have another post - when my wheels start spinning in the mud. cheers Quote
Small Fish Posted May 7, 2009 Author Posted May 7, 2009 Actually I'm stuck already modifying it. I want to find the centerpoint value (x,y) of the circle on each row that has the most left position. In other words the smallest x value. Not sure how to go about doing it when in the while loop. thanks and much appreciated for your time. Quote
Lee Mac Posted May 7, 2009 Posted May 7, 2009 Give this a shot dude: [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:RowAreas [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] jsx test dxf_ent jsx_ename new_xx total areaobj cLst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] jsx [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"CIRCLE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] test [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]sslength[/color][/b] jsx[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] dxf_ent [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] jsx_ename [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] jsx [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] new_xx [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"CIRCLE"[/color][/b][b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]-4[/color][/b] . [b][color=#ff00ff]"*,=,*"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] dxf_ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] total [b][color=#009999]0.0[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] new_xxlst [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]cadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssnamex[/color][/b] new_xx[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] areaobj [b][color=RED]([/color][/b][b][color=BLUE]vla-get-area[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b] total [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] total areaobj[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cLst [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] new_xxlst[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x1 x2[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x1[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] x jsx[b][color=RED])[/color][/b][b][color=RED])[/color][/b] new_xxlst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#ff00ff]"Row "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] test[b][color=RED])[/color][/b] [b][color=#ff00ff]"; Center: "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-princ-to-string[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] cLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#ff00ff]" Y = "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caddr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] dxf_ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#ff00ff]" => "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] total[b][color=RED])[/color][/b] [b][color=#ff00ff]"\n"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] jsx_ename jsx[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] test [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] test[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]textscr[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Quote
Small Fish Posted May 7, 2009 Author Posted May 7, 2009 Thanks Lee Mac brilliant !whew! that was quick. You guys are so brainy :-) Cheers Quote
Small Fish Posted May 8, 2009 Author Posted May 8, 2009 I hope I have not used up all my questions I can ask? One more ..... If I want to use vl-sort to find the circle in the row with the largest radius (similar to finding the left most circle) then I have tried using: (setq Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst) '(lambda (x1 x2) ( however it does not work but I am not sure why Can someone please fix it? Thanks Quote
wizman Posted May 8, 2009 Posted May 8, 2009 Pretty cool Wizman, never knew you could use: lee, i've seen you've already researched on this ssget -4, its one of those under-used features of ssget. *edit - oops your looking for the radius here's for rad: (defun c:RowAreas (/ jsx test dxf_ent jsx_ename new_xx total areaobj cLst big_Area rad) (vl-load-com) (if (setq jsx (ssget "_X" '((0 . "CIRCLE")))) (progn (setq test 1) (while (not (zerop (sslength jsx))) (setq dxf_ent (entget (setq jsx_ename (ssname jsx 0))) new_xx (ssget "_X" (list '(0 . "CIRCLE") '(-4 . "*,=,*") (assoc 10 dxf_ent))) total 0.0 big_Area nil) (foreach ent (setq new_xxlst (mapcar 'cadr (ssnamex new_xx))) (setq areaobj (vla-get-area (vlax-ename->vla-object ent)) total (+ total areaobj))) (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst) '(lambda (x1 x2) (< (car x1) (car x2))))) (setq Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst) '(lambda (x1 x2) (> x1 x2)))) (mapcar '(lambda (x) (ssdel x jsx)) new_xxlst) (princ (strcat "\nRow " (itoa test) "; MinXCtr: " (vl-princ-to-string (car cLst)) " MaxRad = " (vl-princ-to-string (car rad)) " => " " Total = "(rtos total) "\n-----------------------------------------")) (ssdel jsx_ename jsx) (setq test (1+ test))) (textscr))) (princ)) Quote
Small Fish Posted May 8, 2009 Author Posted May 8, 2009 Hi thanks Wizman - I was almost there just missing a 'car' and '>' was around the wrong way thanks once again Quote
Small Fish Posted May 8, 2009 Author Posted May 8, 2009 Okay sorry but now I have another rather tricky problem. My wheels are really spinning in the mud with this one. As I described in my first post I have rows of circles. If I have a vertical line that goes more or less through the whole group of circles. So roughly half the circle centerpoints are on one side of the line and half are on the other. What I would like is to make 2 sets of answers (showing area radius etc) - one for circles on the left and another for the circles on the right. Say Pt1 and Pt2 represent the vertical line. Then the y value that divides the 2 groups would be (setq Yvalue (car Pt1)) Now the next step I am really not sure about how to go about? though I guess I need to use vl-sort and then compare and from make a new two sets and process the 2 sets. Again thanks for any ones time and effort Quote
Lee Mac Posted May 8, 2009 Posted May 8, 2009 lee, i've seen you've already researched on this ssget -4, its one of those under-used features of ssget. Yeah, I posted on the swamp, and received some good info from CAB and others Quote
wizman Posted May 8, 2009 Posted May 8, 2009 im not quite getting last small fish reply, if the line is vertical then he must be checking for the Xvalue right? Quote
Lee Mac Posted May 8, 2009 Posted May 8, 2009 I've got this, but it seems to repeat sometimes and I'm not sure why? [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:RowAreas [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] lEnt lDat ss tCirc subSs total test subSs_lst cLst Rad flag[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lEnt [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Vertical Line: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#ff00ff]"LINE"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] lEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lDat [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] lEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]11[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] lEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n\nLEFT:\n"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]repeat[/color][/b] [b][color=#009900]2[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] test [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"CIRCLE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]sslength[/color][/b] ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] tCirc [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ss [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] subSs [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#ff00ff]"CIRCLE"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]-4[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] flag [b][color=#ff00ff]">=,=,*"[/color][/b] [b][color=#ff00ff]"<=,=,*"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]apply[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] flag [b][color=DARKRED]'[/color][/b][b][color=BLUE]max[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]min[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]car[/color][/b] lDat[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cddr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] tCirc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] total [b][color=#009999]0.0[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] subSs_lst [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]cadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssnamex[/color][/b] subSs[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] total [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] total [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Area[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cLst [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] subSs_lst[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x1 x2[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x1[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Rad [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]40[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] subSs_lst[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]r1 r2[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] r1 r2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] x ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b] subSs_lst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#ff00ff]"\nRow "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] test[b][color=RED])[/color][/b] [b][color=#ff00ff]"; MinXCtr: "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-princ-to-string[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] cLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#ff00ff]" MaxRad = "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-princ-to-string[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] Rad[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#ff00ff]" => "[/color][/b] [b][color=#ff00ff]" Total = "[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] total[b][color=RED])[/color][/b] [b][color=#ff00ff]"\n-----------------------------------------"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] tCirc ss[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] test [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] test[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] flag[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n\nRIGHT:\n"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] flag [b][color=BLUE]T[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]textscr[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n<!> No Line Selected <!>"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED])[/color][/b][b][color=RED])[/color][/b] Quote
wizman Posted May 8, 2009 Posted May 8, 2009 Please try: (defun c:RowAreas (/ lEnt lDat ss tCirc subSs total test subSs_lst cLst Rad flag) (vl-load-com) (if (and (setq lEnt (car (entsel "\nSelect Vertical Line: "))) (eq "LINE" (cdadr (entget lEnt)))) (progn (setq lDat (list (cdr (assoc 10 (entget lEnt))) (cdr (assoc 11 (entget lEnt))))) (princ "\n\nLEFT:\n") (repeat 2 (setq test 1) (if (setq ss (ssget "_X" (list '(0 . "CIRCLE")(cons -4 (if flag ">=,*,*" "<=,*,*")) (cons 10 (append (list (apply (if flag 'max 'min) (mapcar 'car lDat))) '(0 0)))))) (while (not (zerop (sslength ss))) (setq tCirc (ssname ss 0)) (if (setq subSs (ssget "_X" (list (cons 0 "CIRCLE") (cons -4 (if flag ">=,=,*" "<=,=,*")) (cons 10 (append (list (apply (if flag 'max 'min) (mapcar 'car lDat))) (cddr (assoc 10 (entget tCirc)))))))) (progn (setq total 0.0) (foreach ent (setq subSs_lst (mapcar 'cadr (ssnamex subSs))) (setq total (+ total (vla-get-Area (vlax-ename->vla-object ent))))) (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) subSs_lst) '(lambda (x1 x2) (< (car x1) (car x2)))) Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) subSs_lst) '(lambda (r1 r2) (> r1 r2)))) (mapcar '(lambda (x) (ssdel x ss)) subSs_lst) (princ (strcat "\nRow " (itoa test) "; MinXCtr: " (vl-princ-to-string (car cLst)) " MaxRad = " (vl-princ-to-string (car Rad)) " => " " Total = "(rtos total) "\n-----------------------------------------")))) (ssdel tCirc ss) (setq test (1+ test)))) (and (not flag) (princ "\n\nRIGHT:\n")) (setq flag T)) (textscr)) (princ "\n<!> No Line Selected <!>")) (princ )) Quote
Lee Mac Posted May 8, 2009 Posted May 8, 2009 Nice one Wizman, I was trying to do too many things at once I think - and so I didn't filter to original set. Thanks for the modification Quote
Small Fish Posted May 8, 2009 Author Posted May 8, 2009 Hi yes thanks that works well however I wanted to first select the line then make a crossing window over all the circles. I have tried to modify it using (setq ss (ssget (list '(0 . "CIRCLE") for a crossing window however it then ask to make another crossing window (for the right side) So I have made 2 'whiles' rather than repeat. I am also trying to create two seperate answers - one for the left and one for the right rather than one final answer. Its not quite working - can someone please adjust it? thanks cheers (defun c:RowAreas1 (/ lEnt lDat ss tCirc subSs total test subSs_lst cLst Rad flag tCircLeft tCircRight) (vl-load-com) (if (and (setq lEnt (car (entsel "\nSelect Vertical Line: "))) (eq "LINE" (cdadr (entget lEnt)))) (progn (setq lDat (list (cdr (assoc 10 (entget lEnt))) (cdr (assoc 11 (entget lEnt))))) ;;;(princ "\n\nLEFT:\n") ;;; (repeat 2 (setq test 1) (if (setq ss (ssget (list '(0 . "CIRCLE")(cons -4 (if flag ">=,*,*" " (cons 10 (append (list (apply (if flag 'max 'min) (mapcar 'car lDat))) '(0 0)))))) ;circles to the left ;------------------- (while (not (zerop (sslength ss))) (setq tCircLeft (ssname ss 0)) (if (setq subSs (ssget "_X" (list (cons 0 "CIRCLE") (cons -4 (if flag ">=,=,*" " (cons 10 (append (list (apply (if flag 'max 'min) (mapcar 'car lDat))) (cddr (assoc 10 (entget tCirc)))))))) (progn (setq total 0.0) (foreach ent (setq subSs_lst (mapcar 'cadr (ssnamex subSs))) (setq total (+ total (vla-get-Area (vlax-ename->vla-object ent))))) (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) subSs_lst) '(lambda (x1 x2) ( Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) subSs_lst) '(lambda (r1 r2) (> r1 r2)))) (mapcar '(lambda (x) (ssdel x ss)) subSs_lst) (princ (strcat "\nCIRCLES TO THE LEFT" "\nRow " (itoa test) "; MinXCtr: " (vl-princ-to-string (car cLst)) " MaxRad = " (vl-princ-to-string (car Rad)) " => " " Total = "(rtos total) "\n-----------------------------------------")))) (ssdel tCircLeft ss);delete left circles from ss (setq test (1+ test)) );while ;circles to the right ;-------------------- (while (not (zerop (sslength ss))) (setq tCircRight (ssname ss 0)) (if (setq subSs (ssget "_X" (list (cons 0 "CIRCLE") (cons -4 (not(if flag ">=,=,*" " (cons 10 (append (list (apply (if flag 'max 'min) (mapcar 'car lDat))) (cddr (assoc 10 (entget tCirc)))))))) (progn (setq total 0.0) (foreach ent (setq subSs_lst (mapcar 'cadr (ssnamex subSs))) (setq total (+ total (vla-get-Area (vlax-ename->vla-object ent))))) (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) subSs_lst) '(lambda (x1 x2) ( Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) subSs_lst) '(lambda (r1 r2) (> r1 r2)))) (mapcar '(lambda (x) (ssdel x ss)) subSs_lst) (princ (strcat "\nCIRCLES TO THE RIGHT" "\nRow " (itoa test) "; MinXCtr: " (vl-princ-to-string (car cLst)) " MaxRad = " (vl-princ-to-string (car Rad)) " => " " Total = "(rtos total) "\n-----------------------------------------")))) (ssdel tCircRight ss);delete right circles from ss (setq test (1+ test)) );while ) ;if ;;; (and (not flag) (princ "\n\nRIGHT:\n")) ;;; (setq flag T)) (textscr)) (princ "\n No Line Selected ")) (princ )) Quote
wizman Posted May 9, 2009 Posted May 9, 2009 here's a way to still use repeat but instead of ssget "x" use ssget "c" *edit code updated for ssget of subss (defun c:RowAreas (/ lEnt lDat ss tCirc subSs total test subSs_lst cLst Rad flag pt1 pt2) (vl-load-com) (if (and (setq lEnt (car (entsel "\n>>>...Select Vertical Line...>>>: "))) (eq "LINE" (cdadr (entget lEnt))) (null (redraw lEnt 3)) (setq pt1 (getpoint "\n>>>...Pick First Point of Window...>>>: ")) (null (initget 32)) (setq pt2 (getcorner pt1 "\n>>>...Pick Second Point of Window...>>>>: ")) (null (redraw lEnt 4))) (progn (setq lDat (list (cdr (assoc 10 (entget lEnt))) (cdr (assoc 11 (entget lEnt))))) (princ "\n\nLEFT:\n") (repeat 2 (setq test 1) (if (setq ss (ssget "_c" pt1 pt2 (list '(0 . "CIRCLE")(cons -4 (if flag ">=,*,*" "<=,*,*")) (cons 10 (append (list (apply (if flag 'max 'min) (mapcar 'car lDat))) '(0 0)))))) (while (not (zerop (sslength ss))) (setq tCirc (ssname ss 0)) (if (setq subSs (ssget "_c" pt1 pt2 (list (cons 0 "CIRCLE") (cons -4 (if flag ">=,=,*" "<=,=,*")) (cons 10 (append (list (apply (if flag 'max 'min) (mapcar 'car lDat))) (cddr (assoc 10 (entget tCirc)))))))) (progn (setq total 0.0) (foreach ent (setq subSs_lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex subSs)))) (setq total (+ total (vla-get-Area (vlax-ename->vla-object ent))))) (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) subSs_lst) '(lambda (x1 x2) (< (car x1) (car x2)))) Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) subSs_lst) '(lambda (r1 r2) (> r1 r2)))) (mapcar '(lambda (x) (ssdel x ss)) subSs_lst) (princ (strcat "\nRow " (itoa test) "; MinXCtr: " (vl-princ-to-string (car cLst)) " MaxRad = " (vl-princ-to-string (car Rad)) " => " " Total = "(rtos total) "\n-----------------------------------------")))) (ssdel tCirc ss) (setq test (1+ test)))) (and (not flag) (princ "\n\nRIGHT:\n")) (setq flag T)) (textscr)) (princ "\n<!> No Line Selected <!>")) (princ )) Quote
Recommended Posts
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.