Jump to content

Wizman can you help me out please?

Small Fish

By Small Fish
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Small Fish Rising Star

Small Fish

Posted
Posted

Just when I thought I was adding the finishing touches to my code, I now have a flaw, that has driven me insane!

I guess I have asked Lee mac my share of questions. Perhaps Wizman can help me out as he gave me the code

to sort circle rows(along with Lee mac) Wizman did the sorting but Lee mac sorted them in the

right order, and this what I am finding so hard to achieve, amending it to suit.

A vertical line divides the rows of circles. As I said I want to have a Final List that gives

For example- FinalList=((1 (5.0 5.0 5.0)(2(3.0 3.0)(3(8.0 8.0 8.0))

where row 1 has 3 circles of 5.0 radius, row 2 has 2 circles of 3.0 radius etc

 

I would like a 'FinalList' for the right side and a 'FinalList' for the left side of the line.

At the moment I can't get any list.

 

Please help I am going insane trying to make work!

thank you

Here is the code that I have so far:

 

(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
       (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 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
     
   (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2)))))
     (setq test 1)
       (setq FinalList (cons (list test x) FinalList) test (1+ test))
   );foreach
     );if
      (and (not flag) (princ "\n\nRIGHT:\n"))
       (setq flag T)
   );repeat
         );progn
   (princ "\n<!> No Line Selected <!>")
   );if-->for dividing line
 (princ (vl-princ-to-string FinalList))
   (princ )
 );defun

wizman Rising Star

wizman

Posted
Posted

Please try:

 

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

Small Fish Rising Star

Small Fish

Posted
  • Author
Posted

Hey thanks Wizman!

I am very pleased! :-)

Just one other question how can I make 2 sets outside of the 'while'-

one for the right and one for the left?

cheers S.F.

wizman Rising Star

wizman

Posted
Posted
Hey thanks Wizman!

I am very pleased! :-)

Just one other question how can I make 2 sets outside of the 'while'-

one for the right and one for the left?

cheers S.F.

 

 

 

you're welcome small fish, im not sure i get your next question, maybe you just need another variable to store left and right.

 

 

*edit2

 

*deleted wrong comment on princ*

Small Fish Rising Star

Small Fish

Posted
  • Author
Posted

yes that is what I was trying to ask - how can I make a variables for both left and right sets?

If I take away the PRINC it does show any list....

 

 

wizman Rising Star

wizman

Posted
Posted

sorry for confusing, you're right princ needs to be there.

wizman Rising Star

wizman

Posted
Posted

Add the red line for global variable LEFT and RIGHT...:-)

 

..............................................................
);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))
         [color="Red"](SET (IF FLAG 'RIGHT 'LEFT) FINALLIST)[/color]
         (SETQ FINALLIST NIL LISTROWDIA NIL)
  )
     );if
      (and (not flag) (princ "\n\nRIGHT:\n"))
       (setq flag T)
   );repeat
         );progn
   (princ "\n<!> No Line Selected <!>")
   );if-->for dividing line
     (princ )
 );defun

Small Fish Rising Star

Small Fish

Posted
  • Author
Posted

thanks for your time Wizman - that's just what I wanted. One headache gone :-)

cheers Small Fish

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.

×
 Share
Go to topic listing
×
×
  • Create New...