Small Fish Posted June 24, 2009 Posted June 24, 2009 I have a little bug in my code that I had not forseen. The code below works fine (thanks to Wizman and Lee Mac). First a vertical line is selected then it gives out a list of all the circles radi together with its row number, either side of the line. However I have not taken into account circles that have their center point on the vertical line. How can I determine if a circles center is on the vertical line? Obviously there will be only one circle on the line per row - if it does exist. Thanks if you can fix the problem Small Fish (defun c:RowAreas (/ lent ldat ss tcirc subss total test subss_lst clst rad flag new_xxlst listrowdia finallist subss_lst Rad areaobj cLst jsx_ename dxf_ent) (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 (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)))))) (PROGN (while (not (zerop (sslength ss))) (setq dxf_ent (entget (setq jsx_ename (ssname ss 0)))) (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 new_xxlst (mapcar 'cadr (ssnamex subSs))) (setq areaobj (vla-get-area (vlax-ename->vla-object ent)) total (+ total areaobj)) );foreach (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst) '(lambda (x1 x2) (< (car x1) (car x2))));centrepoint Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst) '(lambda (r1 r2) (> r1 r2))));radius (setq ListRowDia (cons (append (list (caddr (assoc 10 (entget (car new_xxlst))))) Rad) ListRowDia)) (mapcar '(lambda (x) (ssdel x ss)) new_xxlst) );progn );if (ssdel jsx_ename ss) );while (SETQ TEST 1) (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2))))) (setq FinalList (cons (list test x) FinalList) test (1+ test)) );foreach (PRINC (VL-PRINC-TO-STRING FINALLIST))(SETQ FINALLIST NIL LISTROWDIA NIL) );PROGN; );if (and (not flag) (princ "\n\nRIGHT:\n")) (setq flag T) );repeat );progn (princ "\n<!> No Line Selected <!>") );if-->for dividing line (princ ) );defun Quote
BIGAL Posted June 24, 2009 Posted June 24, 2009 Simple just check X co-ord of circle centre if equal to lines X co-ord then is on line ! (setq x (cdr (assoc 10 (entget lEnt)))) Quote
Small Fish Posted June 24, 2009 Author Posted June 24, 2009 yes thanks that's the easy bit - but the question is how can I incorporate that into my code for each row of circles? Quote
Lee Mac Posted June 24, 2009 Posted June 24, 2009 yes thanks that's the easy bit - but the question is how can I incorporate that into my code for each row of circles? If you do find this circle on the line, what do you want done with it? i.e. put it left or right or in a new section entirely? Quote
Small Fish Posted June 24, 2009 Author Posted June 24, 2009 yes good question Lee Mac. I am interested in the area of the row in my final result I want to count it as half an area for each side of the line. Also I want to count it as half a circle and not one - which is what's happening at the moment. Quote
Small Fish Posted June 26, 2009 Author Posted June 26, 2009 This might be clearer as to what I am trying to acheive: In my example below there are 2 circles on the at 30 radius on row 2 (left side) 2 circles on the at 30 radius on row 2 (right side) With row 1 there are 2 circles at radius 40 on left and 2 circles on the right However because one circle has its centerpoint on the line its neither on the left or right side The problem is that on row 1, it returns 3 circle radius on the left and 3 circle radius on the right. So I have this in my example: LEFT: ((2 (30.0 30.0)) (1 (40.0 40.0 40.0))) RIGHT: ((2 (30.0 30.0)) (1 (40.0 40.0 40.0))) What I would like is this: LEFT: ((2 (30.0 30.0)) (1 (40.0 40.0))) RIGHT: ((2 (30.0 30.0)) (1 (40.0 40.0))) CENTRE: ((1(40.0))) Any help is gratefully acceptable - this is a bit deep for me to work out thanks Quote
Lee Mac Posted June 27, 2009 Posted June 27, 2009 Haven't really looked at it properly, but not sure if this would work: (will only work with vertical lines) (defun c:RowAreas (/ lent ldat ss tcirc subss total test subss_lst clst rad flag new_xxlst listrowdia finallist subss_lst Rad areaobj cLst jsx_ename dxf_ent) (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 (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)))))) (PROGN (while (not (zerop (sslength ss))) (setq dxf_ent (entget (setq jsx_ename (ssname ss 0)))) (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 new_xxlst (mapcar 'cadr (ssnamex subSs))) (setq areaobj (vla-get-area (vlax-ename->vla-object ent)) total (+ total areaobj)) ) ;foreach (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst) '(lambda (x1 x2) (< (car x1) (car x2)))) ;centrepoint Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst) '(lambda (r1 r2) (> r1 r2)))) ;radius (setq ListRowDia (cons (append (list (caddr (assoc 10 (entget (car new_xxlst))))) Rad) ListRowDia)) (mapcar '(lambda (x) (ssdel x ss)) new_xxlst) ) ;progn ) ;if (ssdel jsx_ename ss) ) ;while (SETQ TEST 1) (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2))))) (setq FinalList (cons (list test x) FinalList) test (1+ test)) ) ;foreach (PRINC (VL-PRINC-TO-STRING FINALLIST)) (SETQ FINALLIST NIL LISTROWDIA NIL) ) ;PROGN; ) ;if (and (not flag) (princ "\n\nRIGHT:\n")) (setq flag T) ) ;repeat (princ "\n\nCENTER:\n") (if (setq ss (ssget "_x" (list '(0 . "CIRCLE") (cons -4 "=,*,*") (cons 10 (list (car lDat) 0 0))))) (PROGN (while (not (zerop (sslength ss))) (setq dxf_ent (entget (setq jsx_ename (ssname ss 0)))) (setq tCirc (ssname ss 0)) (if (setq subSs (ssget "_x" (list (cons 0 "CIRCLE") (cons -4 "=,=,*")) (cons 10 (list (car lDat) 0 0)))) (progn (setq total 0.0) (foreach ent (setq new_xxlst (mapcar 'cadr (ssnamex subSs))) (setq areaobj (vla-get-area (vlax-ename->vla-object ent)) total (+ total areaobj)) ) ;foreach (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst) '(lambda (x1 x2) (< (car x1) (car x2)))) ;centrepoint Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst) '(lambda (r1 r2) (> r1 r2)))) ;radius (setq ListRowDia (cons (append (list (caddr (assoc 10 (entget (car new_xxlst))))) Rad) ListRowDia)) (mapcar '(lambda (x) (ssdel x ss)) new_xxlst) ) ;progn ) ;if (ssdel jsx_ename ss) ) ;while (SETQ TEST 1) (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2))))) (setq FinalList (cons (list test x) FinalList) test (1+ test)) ) ;foreach (PRINC (VL-PRINC-TO-STRING FINALLIST)) (SETQ FINALLIST NIL LISTROWDIA NIL) ) ;PROGN; ) ;if ) ;progn (princ "\n<!> No Line Selected <!>") ) ;if-->for dividing line (princ) ) ;defun {untested of course} Quote
Small Fish Posted June 27, 2009 Author Posted June 27, 2009 Hey thanks Lee Mac - I was beginning to think it could not be done with out major restructuring. Now at least I have something to work on. It stops at the first filter list for the 'center' circle : (list '(0 . "CIRCLE") (cons -4 "=,*,*") (cons 10 (list (car lDat) 0 0))))) So I have tried to modify it by using- (list '(0 . "CIRCLE") '( -4 "=,*,*") (cons 10 (list (car(car lDat)) 0 0)) ))) but then it hooks up at the next filter I am not entirely sure what the second filter is trying to do I know the first filter gets a circle that equals the x value of the line to the x value of the circle but the second filter I get stumped. Quote
Lee Mac Posted June 27, 2009 Posted June 27, 2009 Sorry, I should really spend more time looking into the code a bit more, but try this: (defun c:RowAreas (/ lent ldat ss tcirc subss total test subss_lst clst rad flag new_xxlst listrowdia finallist subss_lst Rad areaobj cLst jsx_ename dxf_ent) (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 (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)))))) (PROGN (while (not (zerop (sslength ss))) (setq dxf_ent (entget (setq jsx_ename (ssname ss 0)))) (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 new_xxlst (mapcar 'cadr (ssnamex subSs))) (setq areaobj (vla-get-area (vlax-ename->vla-object ent)) total (+ total areaobj)) ) ;foreach (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst) '(lambda (x1 x2) (< (car x1) (car x2)))) ;centrepoint Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst) '(lambda (r1 r2) (> r1 r2)))) ;radius (setq ListRowDia (cons (append (list (caddr (assoc 10 (entget (car new_xxlst))))) Rad) ListRowDia)) (mapcar '(lambda (x) (ssdel x ss)) new_xxlst) ) ;progn ) ;if (ssdel jsx_ename ss) ) ;while (SETQ TEST 1) (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2))))) (setq FinalList (cons (list test x) FinalList) test (1+ test)) ) ;foreach (PRINC (VL-PRINC-TO-STRING FINALLIST)) (SETQ FINALLIST NIL LISTROWDIA NIL) ) ;PROGN; ) ;if (and (not flag) (princ "\n\nRIGHT:\n")) (setq flag T) ) ;repeat (princ "\n\nCENTER:\n") (if (setq ss (ssget "_x" (list '(0 . "CIRCLE") (cons -4 "=,*,*") (cons 10 (list (caar lDat) 0 0))))) (PROGN (while (not (zerop (sslength ss))) (setq dxf_ent (entget (setq jsx_ename (ssname ss 0)))) (setq tCirc (ssname ss 0)) (if (setq subSs (ssget "_x" (list (cons 0 "CIRCLE") (cons -4 "=,=,*")) (cons 10 (list (caar lDat) (cddr (assoc 10 (entget tCirc))))))) (progn (setq total 0.0) (foreach ent (setq new_xxlst (mapcar 'cadr (ssnamex subSs))) (setq areaobj (vla-get-area (vlax-ename->vla-object ent)) total (+ total areaobj)) ) ;foreach (setq cLst (vl-sort (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst) '(lambda (x1 x2) (< (car x1) (car x2)))) ;centrepoint Rad (vl-sort (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst) '(lambda (r1 r2) (> r1 r2)))) ;radius (setq ListRowDia (cons (append (list (caddr (assoc 10 (entget (car new_xxlst))))) Rad) ListRowDia)) (mapcar '(lambda (x) (ssdel x ss)) new_xxlst) ) ;progn ) ;if (ssdel jsx_ename ss) ) ;while (SETQ TEST 1) (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2))))) (setq FinalList (cons (list test x) FinalList) test (1+ test)) ) ;foreach (PRINC (VL-PRINC-TO-STRING FINALLIST)) (SETQ FINALLIST NIL LISTROWDIA NIL) ) ;PROGN; ) ;if ) ;progn (princ "\n<!> No Line Selected <!>") ) ;if-->for dividing line (princ) ) ;defun Quote
Small Fish Posted June 28, 2009 Author Posted June 28, 2009 Thanks for the quick reply. It hooks up on the line (second filter) (cons 10(list (caar lDat) (car(cddr (assoc 10 (entget tCirc)))))))) I have played with it and I have checked the list. It returns what you would expect (10 xvalue yvalue) So I don't really understand why it stops there- it does not make sense. Maybe it has something to do with a z value but that also does not seem to make any difference. Quote
Lee Mac Posted June 28, 2009 Posted June 28, 2009 (cons 10(list (caar lDat) (car(cddr (assoc 10 (entget tCirc)))))))) . My above code doesn't contain the above line - is this something you have tried to modify? Quote
Small Fish Posted June 28, 2009 Author Posted June 28, 2009 oops sorry I meant..... (cons 10(list (caar lDat) (cddr (assoc 10 (entget tCirc))))) 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.