exceed Posted July 31, 2023 Share Posted July 31, 2023 (edited) This is a cross-section drawing lisp that fills the cable (inner circle) inside the conduit (outer circle). till now I used the genius array method from this link. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/is-there-any-lisp-to-determine-small-circles-inside-big-circle/m-p/10999596/highlight/true#M428566 However, I don't fill the conduit full in practice. so some parts had to be deleted, i.e. 30% 50% and a method of mixing and inserting cables of different sizes was needed. so, i make this way. At first, like cable tray filling https://www.cadtutor.net/forum/topic/75028-cable-tray-section-for-cable-spacing/, when one layer is filled by changing the radius, the highest height of the layer is set to the bottom of the next layer to create a round filling method, but I thought that was insufficient, so I changed to the offset method. If I make this right, the Circle Packing Alogorithm should be applied, but since it is the same difficult problem as the bin packing problem applied in the rectangle, It's beyond my skills. so I simply used an offset. steps 1. If user enter a new cable diameter, the outer circle is offset by a radius to the inside, 2. and the inner circle is offset by a radius to the outside 3. converts inner circle offsets to a regions, and unions those, and converts it back to a polyline for get vertices 4. and get the intersection points of the inner offset of the outer offset. 5. Then, it is judged whether the points are within the inner offset range of the outer circle, and if they are outside, they are excluded from the candidate. (since it will be placed outside the conduit) 6. Gather a list of points and place a new circle at the point with the lowest y-value. It is decorated as if cables are stacked in the direction of gravity. This is not a complete routine. I need some help with clearing the temporary offset line. Perhaps, in the process of doing the region 2 polyline, only entlast is entered and the rest of the polylines are leaked. I'm dealing with layers because I can't handle them properly. Ideally, it should work within 1 layer. ; ConduitFill - 2023.08.01 exceed ; ; Command List ; ConduitFill - Fill the larger circle with the smaller one. one by one. ; ConduitFill2 - ConduitFill + Enter a small circle with diameter and quantity at once. ; ConduitFillList - ConduitFill by Excel (below Sample Sheet neeeded) ; ConduitFillListSample - Make Sample Excel Sheet for ConduitFillList & TrayFillList ; ; TrayFill - Fill the Box with small circle. one by one. ; TrayFill2 - TrayFill + Enter a small circle with diameter and quantity at once. ; TrayFillList - TrayFill by Excel (below Sample Sheet neeeded) (defun C:ConduitFill (/ acdoc util big_center big_diameter big_area small_area fill_rate big_circle_ent big_circle_obj small_circle_list ss ss3 old_dia_for_color setcolor counter small_diameter big_offset big_offset_obj delent small_circle_coord small_circle_coord_stack small_circle_ent small_text small_area int small_offset small_offset_obj small_offset_coord univss univent univindex dist index setcolor int small_circle_coord_stack big_offset_obj big_center ) (setvar 'cmdecho 0) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (setvar 'cmdecho 1) (princ) ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark acdoc) (setq util (vla-get-utility acdoc)) (setq big_center (getpoint "\n Enter the center point of the large circle : ")) (setq big_diameter (getreal "\n Enter the Diameter of the large circle : ")) (setq big_area (* pi (expt (/ big_diameter 2) 2))) (setq small_area 0) (setq fill_rate 0) (setq big_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 10 big_center) (cons 40 (/ big_diameter 2)) ) ) ) (setq big_circle_obj (vlax-ename->vla-object big_circle_ent)) (setq small_circle_list '()) (setq ss (ssadd)) (setq ss3 (ssadd)) (setq old_dia_for_color -1) (setq setcolor 0) (setq counter 0) (while (and (setq small_diameter (getreal "\n Enter the Diameter of the small circle : ")) (> big_diameter small_diameter) ) (if (/= old_dia_for_color small_diameter) (progn (setq setcolor (+ setcolor 1)) ) ) (if (/= big_offset_obj nil) (entdel (vlax-vla-object->ename big_offset_obj)) ) (setq big_offset (entmakex (list '(0 . "CIRCLE") (cons 10 big_center) (cons 62 8) (cons 40 (- (/ big_diameter 2) (/ small_diameter 2))) ) ) ) (setq big_offset_obj (vlax-ename->vla-object big_offset)) (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) (if (= counter 0) (progn (setq small_circle_coord (polar big_center (* 1.5 pi) (- (/ big_diameter 2) (/ small_diameter 2)) ) ) ;(setq small_circle_coord_stack (list small_circle_coord)) ) (progn (setq index 0) (setq ss (ssadd)) (repeat (length small_circle_list) (setq old_circle (nth index small_circle_list)) (setq small_offset (entmakex (list '(0 . "CIRCLE") (cons 10 (car old_circle)) (cons 62 8) (cons 40 (+ (cadr old_circle) (/ small_diameter 2) ) ) ) ) ) (command "region" small_offset "") (ssadd (entlast) ss) (setq index (+ index 1)) ) (if (> (length small_circle_list) 1) (progn (command "union" ss "") (setq ss3 (ssadd)) (setq ss3 (ssget "_P" '((0 . "REGION")))) (setq univss (ssadd)) (setq univss (Region2Polyline ss3)) (setq univindex 0) (setq small_circle_coord_stack '()) (repeat (sslength univss) (setq univent (ssname univss univindex)) (ssadd univent ss) (setq small_offset_obj (vlax-ename->vla-object univent)) (vlax-put-property small_offset_obj 'Color 8) (setq small_offset_coord (vlax-safearray->list (vlax-variant-value (vlax-get-property small_offset_obj 'Coordinates ) ) ) ) (repeat (/ (length small_offset_coord) 2) (setq dist (distance big_center (list (car small_offset_coord) (cadr small_offset_coord) 0 ) ) ) (if (> dist (- (/ big_diameter 2) (/ small_diameter 2))) (progn) (progn (setq small_circle_coord_stack (cons (list (car small_offset_coord) (cadr small_offset_coord) 0 ) small_circle_coord_stack ) ) ) ) (setq small_offset_coord (cddr small_offset_coord)) ) (setq univindex (+ 1 univindex)) ) (command "erase" ss3 "") ) (progn (setq small_offset_obj (vlax-ename->vla-object (entlast))) (vlax-put-property small_offset_obj 'Color 8) (ssadd (entlast) ss) ) ) (setq int (LM:intersections big_offset_obj small_offset_obj acextendnone)) (repeat (length int) (setq small_circle_coord_stack (cons (car int) small_circle_coord_stack)) (setq int (cdr int)) ) (setq small_circle_coord_stack (vl-sort small_circle_coord_stack '(lambda (x y) (if (eq (cadr x) (cadr y)) (< (car x) (car y)) (< (cadr x) (cadr y)) ) ;(< (cadr x) (cadr y)) ) ) ) ;(princ "\n list - ") ;(princ small_circle_coord_stack) (setq small_circle_coord '()) (setq small_circle_coord (car small_circle_coord_stack)) ) ) (if (and (/= small_circle_coord '()) (/= small_circle_coord nil)) (progn (setq small_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 62 setcolor) (cons 10 small_circle_coord) (cons 40 (/ small_diameter 2)) ) ) ) (setq small_text (entmakex (list (cons 0 "TEXT") (cons 62 setcolor) (cons 11 small_circle_coord) (cons 40 (/ small_diameter 2)) (cons 1 (vl-princ-to-string (+ counter 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 71 0) (cons 72 1) (cons 73 2) ) ) ) (setq small_circle_list (cons (list small_circle_coord (/ small_diameter 2)) small_circle_list ) ) (setq small_area (+ small_area (* pi (expt (/ small_diameter 2) 2)))) (setq fill_rate (* (/ small_area big_area) 100)) (princ "\n Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (setq old_dia_for_color small_diameter) (setq counter (+ counter 1)) ) (progn) ) (if (and (> counter 0) (= small_circle_coord_stack nil)) (progn "\n OverFilling") ) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-endundomark acdoc) (setvar 'cmdecho 1) (princ) ) (defun C:ConduitFill2 (/ acdoc small_quantity util big_center big_diameter big_area small_area fill_rate big_circle_ent big_circle_obj small_circle_list ss ss3 old_dia_for_color setcolor counter small_diameter big_offset big_offset_obj delent small_circle_coord small_circle_coord_stack small_circle_ent small_text small_area int small_offset small_offset_obj small_offset_coord univss univent univindex dist index setcolor int small_circle_coord_stack big_offset_obj big_center ) (setvar 'cmdecho 0) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (setvar 'cmdecho 1) (princ) ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark acdoc) (setq util (vla-get-utility acdoc)) (setq big_center (getpoint "\n Enter the center point of the large circle : ")) (setq big_diameter (getreal "\n Enter the Diameter of the large circle : ")) (setq big_area (* pi (expt (/ big_diameter 2) 2))) (setq small_area 0) (setq fill_rate 0) (setq big_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 10 big_center) (cons 40 (/ big_diameter 2)) ) ) ) (setq big_circle_obj (vlax-ename->vla-object big_circle_ent)) (setq small_circle_list '()) (setq ss (ssadd)) (setq ss3 (ssadd)) (setq old_dia_for_color -1) (setq setcolor 0) (setq counter 0) (while (and (setq small_diameter (getreal "\n Enter the Diameter of the small circle : ")) (setq small_quantity (getint "\n How many of this size of cable will you fill?")) (> big_diameter small_diameter) ) (repeat small_quantity (if (/= old_dia_for_color small_diameter) (progn (setq setcolor (+ setcolor 1)) ) ) (if (/= big_offset_obj nil) (entdel (vlax-vla-object->ename big_offset_obj)) ) (setq big_offset (entmakex (list '(0 . "CIRCLE") (cons 10 big_center) (cons 62 8) (cons 40 (- (/ big_diameter 2) (/ small_diameter 2)) ) ) ) ) (setq big_offset_obj (vlax-ename->vla-object big_offset)) (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) (if (= counter 0) (progn (setq small_circle_coord (polar big_center (* 1.5 pi) (- (/ big_diameter 2) (/ small_diameter 2) ) ) ) ;(setq small_circle_coord_stack (list small_circle_coord)) ) (progn (setq index 0) (setq ss (ssadd)) (repeat (length small_circle_list) (setq old_circle (nth index small_circle_list)) (setq small_offset (entmakex (list '(0 . "CIRCLE") (cons 10 (car old_circle)) (cons 62 8) (cons 40 (+ (cadr old_circle) (/ small_diameter 2) ) ) ) ) ) (command "region" small_offset "") (ssadd (entlast) ss) (setq index (+ index 1)) ) (if (> (length small_circle_list) 1) (progn (command "union" ss "") (setq ss3 (ssadd)) (setq ss3 (ssget "_P" '((0 . "REGION")))) (setq univss (ssadd)) (setq univss (Region2Polyline ss3)) (setq univindex 0) (setq small_circle_coord_stack '()) (repeat (sslength univss) (setq univent (ssname univss univindex)) (ssadd univent ss) (setq small_offset_obj (vlax-ename->vla-object univent)) (vlax-put-property small_offset_obj 'Color 8) (setq small_offset_coord (vlax-safearray->list (vlax-variant-value (vlax-get-property small_offset_obj 'Coordinates ) ) ) ) (repeat (/ (length small_offset_coord) 2) (setq dist (distance big_center (list (car small_offset_coord) (cadr small_offset_coord) 0 ) ) ) (if (> dist (- (/ big_diameter 2) (/ small_diameter 2))) (progn) (progn (setq small_circle_coord_stack (cons (list (car small_offset_coord) (cadr small_offset_coord) 0 ) small_circle_coord_stack ) ) ) ) (setq small_offset_coord (cddr small_offset_coord)) ) (setq univindex (+ 1 univindex)) ) (command "erase" ss3 "") ) (progn (setq small_offset_obj (vlax-ename->vla-object (entlast))) (vlax-put-property small_offset_obj 'Color 8) (ssadd (entlast) ss) ) ) (setq int (LM:intersections big_offset_obj small_offset_obj acextendnone)) (repeat (length int) (setq small_circle_coord_stack (cons (car int) small_circle_coord_stack ) ) (setq int (cdr int)) ) (setq small_circle_coord_stack (vl-sort small_circle_coord_stack '(lambda (x y) (if (eq (cadr x) (cadr y)) (< (car x) (car y)) (< (cadr x) (cadr y)) ) ;(< (cadr x) (cadr y)) ) ) ) ;(princ "\n list - ") ;(princ small_circle_coord_stack) (setq small_circle_coord '()) (setq small_circle_coord (car small_circle_coord_stack)) ) ) (if (and (/= small_circle_coord '()) (/= small_circle_coord nil)) (progn (setq small_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 62 setcolor) (cons 10 small_circle_coord) (cons 40 (/ small_diameter 2)) ) ) ) (setq small_text (entmakex (list (cons 0 "TEXT") (cons 62 setcolor) (cons 11 small_circle_coord) (cons 40 (/ small_diameter 2)) (cons 1 (vl-princ-to-string (+ counter 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 71 0) (cons 72 1) (cons 73 2) ) ) ) (setq small_circle_list (cons (list small_circle_coord (/ small_diameter 2)) small_circle_list ) ) (setq small_area (+ small_area (* pi (expt (/ small_diameter 2) 2)))) (setq fill_rate (* (/ small_area big_area) 100)) (princ "\n Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (setq old_dia_for_color small_diameter) (setq counter (+ counter 1)) ) (progn) ) (if (and (> counter 0) (= small_circle_coord_stack nil)) (progn "\n OverFilling") ) ) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-endundomark acdoc) (setvar 'cmdecho 1) (princ) ) (defun C:ConduitFillList (/ acdoc small_quantity util big_center big_diameter big_area small_area fill_rate big_circle_ent big_circle_obj small_circle_list ss ss3 old_dia_for_color setcolor counter small_diameter big_offset big_offset_obj delent small_circle_coord small_circle_coord_stack small_circle_ent small_text small_area int small_offset small_offset_obj small_offset_coord univss univent univindex dist index setcolor int small_circle_coord_stack big_offset_obj big_center txtstring txtedit1 rowcount rowlast scstack index selectedrow selectedrowlist sclist ) (setvar 'cmdecho 0) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (setvar 'cmdecho 1) (princ) ) (setq txtstring (@GetClipBoardText)) (setq txtedit1 (LM:str->lst txtstring "\r\n")) (setq rowcount (length txtedit1)) (setq rowlast (last txtedit1)) (if (= rowlast "") (setq rowcount (- rowcount 1)) (setq rowcount rowcount) ) (setq scstack '()) (setq index 0) (repeat rowcount (setq selectedrow (nth index txtedit1)) (setq selectedrowlist (LM:str->lst selectedrow "\t")) (setq sclist '()) (setq sclist (list (car selectedrowlist) (cadr selectedrowlist))) (setq scstack (cons sclist scstack)) (setq index (+ index 1)) ) (setq scstack (reverse scstack)) (setq big_diameter (atof (vl-princ-to-string (cadr (nth 1 scstack))))) (setq cable_info_list (cdddr scstack)) ;| (defun mysort2 ( l ) (vl-sort l '(lambda ( a b ) (if (eq (cadr a) (cadr b)) (< (car a) (car b)) (> (cadr a) (cadr b)) ) ) ) ) (setq cable_info_list (mysort2 cable_info_list)) |; (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark acdoc) (setq util (vla-get-utility acdoc)) (setq big_center (getpoint "\n Enter the center point of the large circle : ")) ;(setq big_diameter (getreal "\n Enter the Diameter of the large circle : ")) (setq big_area (* pi (expt (/ big_diameter 2) 2))) (setq small_area 0) (setq fill_rate 0) (setq big_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 10 big_center) (cons 40 (/ big_diameter 2)) ) ) ) (setq big_circle_obj (vlax-ename->vla-object big_circle_ent)) (setq small_circle_list '()) (setq ss (ssadd)) (setq ss3 (ssadd)) (setq old_dia_for_color -1) (setq setcolor 0) (setq counter 0) (repeat (length cable_info_list) (setq small_diameter (atof (vl-princ-to-string (cadr (car cable_info_list))))) (if (> big_diameter small_diameter) (progn (if (/= old_dia_for_color small_diameter) (progn (setq setcolor (+ setcolor 1)) ) ) (if (/= big_offset_obj nil) (entdel (vlax-vla-object->ename big_offset_obj)) ) (setq big_offset (entmakex (list '(0 . "CIRCLE") (cons 10 big_center) (cons 62 8) (cons 40 (- (/ big_diameter 2) (/ small_diameter 2)) ) ) ) ) (setq big_offset_obj (vlax-ename->vla-object big_offset)) (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) (if (= counter 0) (progn (setq small_circle_coord (polar big_center (* 1.5 pi) (- (/ big_diameter 2) (/ small_diameter 2) ) ) ) ;(setq small_circle_coord_stack (list small_circle_coord)) ) (progn (setq index 0) (setq ss (ssadd)) (repeat (length small_circle_list) (setq old_circle (nth index small_circle_list)) (setq small_offset (entmakex (list '(0 . "CIRCLE") (cons 10 (car old_circle)) (cons 62 8) (cons 40 (+ (cadr old_circle) (/ small_diameter 2) ) ) ) ) ) (command "region" small_offset "") (ssadd (entlast) ss) (setq index (+ index 1)) ) (if (> (length small_circle_list) 1) (progn (command "union" ss "") (setq ss3 (ssadd)) (setq ss3 (ssget "_P" '((0 . "REGION")))) (setq univss (ssadd)) (setq univss (Region2Polyline ss3)) (setq univindex 0) (setq small_circle_coord_stack '()) (repeat (sslength univss) (setq univent (ssname univss univindex)) (ssadd univent ss) (setq small_offset_obj (vlax-ename->vla-object univent)) (vlax-put-property small_offset_obj 'Color 8) (setq small_offset_coord (vlax-safearray->list (vlax-variant-value (vlax-get-property small_offset_obj 'Coordinates ) ) ) ) (repeat (/ (length small_offset_coord) 2) (setq dist (distance big_center (list (car small_offset_coord) (cadr small_offset_coord) 0 ) ) ) (if (> dist (- (/ big_diameter 2) (/ small_diameter 2))) (progn) (progn (setq small_circle_coord_stack (cons (list (car small_offset_coord) (cadr small_offset_coord) 0 ) small_circle_coord_stack ) ) ) ) (setq small_offset_coord (cddr small_offset_coord)) ) (setq univindex (+ 1 univindex)) ) (command "erase" ss3 "") ) (progn (setq small_offset_obj (vlax-ename->vla-object (entlast))) (vlax-put-property small_offset_obj 'Color 8) (ssadd (entlast) ss) ) ) (setq int (LM:intersections big_offset_obj small_offset_obj acextendnone ) ) (repeat (length int) (setq small_circle_coord_stack (cons (car int) small_circle_coord_stack ) ) (setq int (cdr int)) ) (setq small_circle_coord_stack (vl-sort small_circle_coord_stack '(lambda (x y) (if (eq (cadr x) (cadr y)) (< (car x) (car y)) (< (cadr x) (cadr y)) ) ;(< (cadr x) (cadr y)) ) ) ) ;(princ "\n list - ") ;(princ small_circle_coord_stack) (setq small_circle_coord '()) (setq small_circle_coord (car small_circle_coord_stack)) ) ) (if (and (/= small_circle_coord '()) (/= small_circle_coord nil)) (progn (setq small_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 62 setcolor) (cons 10 small_circle_coord) (cons 40 (/ small_diameter 2)) ) ) ) (setq small_text (entmakex (list (cons 0 "TEXT") (cons 62 setcolor) (cons 11 small_circle_coord) (cons 40 (/ small_diameter 2)) (cons 1 (vl-princ-to-string (+ counter 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 71 0) (cons 72 1) (cons 73 2) ) ) ) (setq small_circle_list (cons (list small_circle_coord (/ small_diameter 2) ) small_circle_list ) ) (setq small_area (+ small_area (* pi (expt (/ small_diameter 2) 2)))) (setq fill_rate (* (/ small_area big_area) 100)) (princ "\n Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (setq old_dia_for_color small_diameter) (setq counter (+ counter 1)) ) (progn) ) (if (and (> counter 0) (= small_circle_coord_stack nil)) (progn "\n OverFilling") ) ) (progn) ) (setq cable_info_list (cdr cable_info_list)) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-endundomark acdoc) (setvar 'cmdecho 1) (princ) ) (defun C:TrayFill (/ acdoc util big_height big_center big_diameter big_area small_area fill_rate big_circle_ent big_circle_obj small_circle_list ss ss3 old_dia_for_color setcolor counter small_diameter big_offset big_offset_obj delent small_circle_coord small_circle_coord_stack small_circle_ent small_text small_area int small_offset small_offset_obj small_offset_coord univss univent univindex dist index setcolor int small_circle_coord_stack big_offset_obj big_center ) (setvar 'cmdecho 0) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (setvar 'cmdecho 1) (princ) ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark acdoc) (setq util (vla-get-utility acdoc)) (setq big_center (getpoint "\n Enter the center point of the Tray : ")) (setq big_diameter (getreal "\n Enter the Width of the Tray : ")) (setq big_height (getreal "\n Enter the Height of the Tray : ")) (setq big_area (* big_height big_diameter)) (setq small_area 0) (setq fill_rate 0) (setq big_circle_ent (entmakex (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (- (car big_center) (/ big_diameter 2)) (+ (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (car big_center) (/ big_diameter 2)) (+ (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (car big_center) (/ big_diameter 2)) (- (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (car big_center) (/ big_diameter 2)) (- (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ) ) (setq big_circle_obj (vlax-ename->vla-object big_circle_ent)) (setq small_circle_list '()) (setq ss (ssadd)) (setq ss3 (ssadd)) (setq old_dia_for_color -1) (setq setcolor 0) (setq counter 0) (while (and (setq small_diameter (getreal "\n Enter the Diameter of the small circle : ")) (> big_diameter small_diameter) ) (if (/= old_dia_for_color small_diameter) (progn (setq setcolor (+ setcolor 1)) ) ) (if (/= big_offset_obj nil) (entdel (vlax-vla-object->ename big_offset_obj)) ) (setq big_offset (entmakex (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 62 8) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ) ) (setq big_offset_obj (vlax-ename->vla-object big_offset)) (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) (if (= counter 0) (progn (setq small_circle_coord (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2))) ) ;(setq small_circle_coord_stack (list small_circle_coord)) ) (progn (setq index 0) (setq ss (ssadd)) (repeat (length small_circle_list) (setq old_circle (nth index small_circle_list)) (setq small_offset (entmakex (list '(0 . "CIRCLE") (cons 10 (car old_circle)) (cons 62 8) (cons 40 (+ (cadr old_circle) (/ small_diameter 2) ) ) ) ) ) (command "region" small_offset "") (ssadd (entlast) ss) (setq index (+ index 1)) ) (if (> (length small_circle_list) 1) (progn (command "union" ss "") (setq ss3 (ssadd)) (setq ss3 (ssget "_P" '((0 . "REGION")))) (setq univss (ssadd)) (setq univss (Region2Polyline ss3)) (setq univindex 0) (setq small_circle_coord_stack '()) (repeat (sslength univss) (setq univent (ssname univss univindex)) (ssadd univent ss) (setq small_offset_obj (vlax-ename->vla-object univent)) (vlax-put-property small_offset_obj 'Color 8) (setq small_offset_coord (vlax-safearray->list (vlax-variant-value (vlax-get-property small_offset_obj 'Coordinates ) ) ) ) (repeat (/ (length small_offset_coord) 2) (if (and (and (>= (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (car small_offset_coord)) (>= (car small_offset_coord) (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)))) (and (<= (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)) (cadr small_offset_coord)) (<= (cadr small_offset_coord) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) ) (progn (setq small_circle_coord_stack (cons (list (car small_offset_coord) (cadr small_offset_coord) 0 ) small_circle_coord_stack ) ) ;(princ (list (car small_offset_coord) ; (cadr small_offset_coord) ; 0 ; )) ;(princ small_circle_coord_stack) ;(princ "ok") ) (progn ; (princ (list (car small_offset_coord) ; (cadr small_offset_coord) ; 0 ; )) ;(princ "not ok") ) ) (setq small_offset_coord (cddr small_offset_coord)) ) (setq univindex (+ 1 univindex)) ) (command "erase" ss3 "") ) (progn (setq small_offset_obj (vlax-ename->vla-object (entlast))) (vlax-put-property small_offset_obj 'Color 8) (ssadd (entlast) ss) ) ) ;(princ small_circle_coord_stack) (setq int (LM:intersections big_offset_obj small_offset_obj acextendnone)) (repeat (length int) (setq small_circle_coord_stack (cons (car int) small_circle_coord_stack)) (setq int (cdr int)) ) (setq small_circle_coord_stack (vl-sort small_circle_coord_stack '(lambda (x y) (if (eq (cadr x) (cadr y)) (< (car x) (car y)) (< (cadr x) (cadr y)) ) ;(< (cadr x) (cadr y)) ) ) ) ;(princ "\n list - ") ;(princ small_circle_coord_stack) (setq small_circle_coord '()) (setq small_circle_coord (car small_circle_coord_stack)) ) ) (if (and (/= small_circle_coord '()) (/= small_circle_coord nil)) (progn (setq small_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 62 setcolor) (cons 10 small_circle_coord) (cons 40 (/ small_diameter 2)) ) ) ) (setq small_text (entmakex (list (cons 0 "TEXT") (cons 62 setcolor) (cons 11 small_circle_coord) (cons 40 (/ small_diameter 2)) (cons 1 (vl-princ-to-string (+ counter 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 71 0) (cons 72 1) (cons 73 2) ) ) ) (setq small_circle_list (cons (list small_circle_coord (/ small_diameter 2)) small_circle_list ) ) (setq small_area (+ small_area (* pi (expt (/ small_diameter 2) 2)))) (setq fill_rate (* (/ small_area big_area) 100)) (princ "\n Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (setq old_dia_for_color small_diameter) (setq counter (+ counter 1)) ) (progn) ) (if (and (> counter 0) (= small_circle_coord_stack nil)) (progn "\n OverFilling") ) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-endundomark acdoc) (setvar 'cmdecho 1) (princ) ) (defun C:TrayFill2 (/ acdoc util big_height big_center big_diameter big_area small_quantity small_area fill_rate big_circle_ent big_circle_obj small_circle_list ss ss3 old_dia_for_color setcolor counter small_diameter big_offset big_offset_obj delent small_circle_coord small_circle_coord_stack small_circle_ent small_text small_area int small_offset small_offset_obj small_offset_coord univss univent univindex dist index setcolor int small_circle_coord_stack big_offset_obj big_center ) (setvar 'cmdecho 0) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (setvar 'cmdecho 1) (princ) ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark acdoc) (setq util (vla-get-utility acdoc)) (setq big_center (getpoint "\n Enter the center point of the Tray : ")) (setq big_diameter (getreal "\n Enter the Width of the Tray : ")) (setq big_height (getreal "\n Enter the Height of the Tray : ")) (setq big_area (* big_height big_diameter)) (setq small_area 0) (setq fill_rate 0) (setq big_circle_ent (entmakex (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (- (car big_center) (/ big_diameter 2)) (+ (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (car big_center) (/ big_diameter 2)) (+ (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (car big_center) (/ big_diameter 2)) (- (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (car big_center) (/ big_diameter 2)) (- (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ) ) (setq big_circle_obj (vlax-ename->vla-object big_circle_ent)) (setq small_circle_list '()) (setq ss (ssadd)) (setq ss3 (ssadd)) (setq old_dia_for_color -1) (setq setcolor 0) (setq counter 0) (while (and (setq small_diameter (getreal "\n Enter the Diameter of the small circle : ")) (setq small_quantity (getint "\n How many of this size of cable will you fill?")) (> big_diameter small_diameter) ) (repeat small_quantity (if (/= old_dia_for_color small_diameter) (progn (setq setcolor (+ setcolor 1)) ) ) (if (/= big_offset_obj nil) (entdel (vlax-vla-object->ename big_offset_obj)) ) (setq big_offset (entmakex (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 62 8) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ) ) (setq big_offset_obj (vlax-ename->vla-object big_offset)) (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) (if (= counter 0) (progn (setq small_circle_coord (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2))) ) ;(setq small_circle_coord_stack (list small_circle_coord)) ) (progn (setq index 0) (setq ss (ssadd)) (repeat (length small_circle_list) (setq old_circle (nth index small_circle_list)) (setq small_offset (entmakex (list '(0 . "CIRCLE") (cons 10 (car old_circle)) (cons 62 8) (cons 40 (+ (cadr old_circle) (/ small_diameter 2) ) ) ) ) ) (command "region" small_offset "") (ssadd (entlast) ss) (setq index (+ index 1)) ) (if (> (length small_circle_list) 1) (progn (command "union" ss "") (setq ss3 (ssadd)) (setq ss3 (ssget "_P" '((0 . "REGION")))) (setq univss (ssadd)) (setq univss (Region2Polyline ss3)) (setq univindex 0) (setq small_circle_coord_stack '()) (repeat (sslength univss) (setq univent (ssname univss univindex)) (ssadd univent ss) (setq small_offset_obj (vlax-ename->vla-object univent)) (vlax-put-property small_offset_obj 'Color 8) (setq small_offset_coord (vlax-safearray->list (vlax-variant-value (vlax-get-property small_offset_obj 'Coordinates ) ) ) ) (repeat (/ (length small_offset_coord) 2) (if (and (and (>= (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (car small_offset_coord)) (>= (car small_offset_coord) (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)))) (and (<= (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)) (cadr small_offset_coord)) (<= (cadr small_offset_coord) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) ) (progn (setq small_circle_coord_stack (cons (list (car small_offset_coord) (cadr small_offset_coord) 0 ) small_circle_coord_stack ) ) ;(princ (list (car small_offset_coord) ; (cadr small_offset_coord) ; 0 ; )) ;(princ small_circle_coord_stack) ;(princ "ok") ) (progn ; (princ (list (car small_offset_coord) ; (cadr small_offset_coord) ; 0 ; )) ;(princ "not ok") ) ) (setq small_offset_coord (cddr small_offset_coord)) ) (setq univindex (+ 1 univindex)) ) (command "erase" ss3 "") ) (progn (setq small_offset_obj (vlax-ename->vla-object (entlast))) (vlax-put-property small_offset_obj 'Color 8) (ssadd (entlast) ss) ) ) ;(princ small_circle_coord_stack) (setq int (LM:intersections big_offset_obj small_offset_obj acextendnone)) (repeat (length int) (setq small_circle_coord_stack (cons (car int) small_circle_coord_stack)) (setq int (cdr int)) ) (setq small_circle_coord_stack (vl-sort small_circle_coord_stack '(lambda (x y) (if (eq (cadr x) (cadr y)) (< (car x) (car y)) (< (cadr x) (cadr y)) ) ;(< (cadr x) (cadr y)) ) ) ) ;(princ "\n list - ") ;(princ small_circle_coord_stack) (setq small_circle_coord '()) (setq small_circle_coord (car small_circle_coord_stack)) ) ) (if (and (/= small_circle_coord '()) (/= small_circle_coord nil)) (progn (setq small_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 62 setcolor) (cons 10 small_circle_coord) (cons 40 (/ small_diameter 2)) ) ) ) (setq small_text (entmakex (list (cons 0 "TEXT") (cons 62 setcolor) (cons 11 small_circle_coord) (cons 40 (/ small_diameter 2)) (cons 1 (vl-princ-to-string (+ counter 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 71 0) (cons 72 1) (cons 73 2) ) ) ) (setq small_circle_list (cons (list small_circle_coord (/ small_diameter 2)) small_circle_list ) ) (setq small_area (+ small_area (* pi (expt (/ small_diameter 2) 2)))) (setq fill_rate (* (/ small_area big_area) 100)) (princ "\n Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (setq old_dia_for_color small_diameter) (setq counter (+ counter 1)) ) (progn) ) (if (and (> counter 0) (= small_circle_coord_stack nil)) (progn "\n OverFilling") ) ) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-endundomark acdoc) (setvar 'cmdecho 1) (princ) ) (defun C:TrayFillList (/ acdoc util big_height big_center big_diameter big_area small_area fill_rate big_circle_ent big_circle_obj small_circle_list ss ss3 old_dia_for_color setcolor counter small_diameter big_offset big_offset_obj delent small_circle_coord small_circle_coord_stack small_circle_ent small_text small_area int small_offset small_offset_obj small_offset_coord univss univent univindex dist index setcolor int small_circle_coord_stack big_offset_obj big_center txtstring txtedit1 rowcount rowlast scstack index selectedrow selectedrowlist sclist ) (setvar 'cmdecho 0) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (setvar 'cmdecho 1) (princ) ) (setq txtstring (@GetClipBoardText)) (setq txtedit1 (LM:str->lst txtstring "\r\n")) (setq rowcount (length txtedit1)) (setq rowlast (last txtedit1)) (if (= rowlast "") (setq rowcount (- rowcount 1)) (setq rowcount rowcount) ) (setq scstack '()) (setq index 0) (repeat rowcount (setq selectedrow (nth index txtedit1)) (setq selectedrowlist (LM:str->lst selectedrow "\t")) (setq sclist '()) (setq sclist (list (car selectedrowlist) (cadr selectedrowlist))) (setq scstack (cons sclist scstack)) (setq index (+ index 1)) ) (setq scstack (reverse scstack)) (setq big_diameter (atof (vl-princ-to-string (cadr (nth 1 scstack))))) (setq big_height (atof (vl-princ-to-string (cadr (nth 2 scstack))))) (setq cable_info_list (cddddr scstack)) ;| (defun mysort2 ( l ) (vl-sort l '(lambda ( a b ) (if (eq (cadr a) (cadr b)) (< (car a) (car b)) (> (cadr a) (cadr b)) ) ) ) ) (setq cable_info_list (mysort2 cable_info_list)) |; (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark acdoc) (setq util (vla-get-utility acdoc)) (setq big_center (getpoint "\n Enter the center point of the Tray : ")) ;(setq big_diameter (getreal "\n Enter the Width of the Tray : ")) ;(setq big_height (getreal "\n Enter the Height of the Tray : ")) (setq big_area (* big_height big_diameter)) (setq small_area 0) (setq fill_rate 0) (setq big_circle_ent (entmakex (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (- (car big_center) (/ big_diameter 2)) (+ (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (car big_center) (/ big_diameter 2)) (+ (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (car big_center) (/ big_diameter 2)) (- (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (car big_center) (/ big_diameter 2)) (- (cadr big_center) (/ big_height 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ) ) (setq big_circle_obj (vlax-ename->vla-object big_circle_ent)) (setq small_circle_list '()) (setq ss (ssadd)) (setq ss3 (ssadd)) (setq old_dia_for_color -1) (setq setcolor 0) (setq counter 0) (repeat (length cable_info_list) (setq small_diameter (atof (vl-princ-to-string (cadr (car cable_info_list))))) (if (> big_diameter small_diameter) (progn (if (/= old_dia_for_color small_diameter) (progn (setq setcolor (+ setcolor 1)) ) ) (if (/= big_offset_obj nil) (entdel (vlax-vla-object->ename big_offset_obj)) ) (setq big_offset (entmakex (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 62 8) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ) ) (setq big_offset_obj (vlax-ename->vla-object big_offset)) (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) (if (= counter 0) (progn (setq small_circle_coord (list (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2))) ) ;(setq small_circle_coord_stack (list small_circle_coord)) ) (progn (setq index 0) (setq ss (ssadd)) (repeat (length small_circle_list) (setq old_circle (nth index small_circle_list)) (setq small_offset (entmakex (list '(0 . "CIRCLE") (cons 10 (car old_circle)) (cons 62 8) (cons 40 (+ (cadr old_circle) (/ small_diameter 2) ) ) ) ) ) (command "region" small_offset "") (ssadd (entlast) ss) (setq index (+ index 1)) ) (if (> (length small_circle_list) 1) (progn (command "union" ss "") (setq ss3 (ssadd)) (setq ss3 (ssget "_P" '((0 . "REGION")))) (setq univss (ssadd)) (setq univss (Region2Polyline ss3)) (setq univindex 0) (setq small_circle_coord_stack '()) (repeat (sslength univss) (setq univent (ssname univss univindex)) (ssadd univent ss) (setq small_offset_obj (vlax-ename->vla-object univent)) (vlax-put-property small_offset_obj 'Color 8) (setq small_offset_coord (vlax-safearray->list (vlax-variant-value (vlax-get-property small_offset_obj 'Coordinates ) ) ) ) (repeat (/ (length small_offset_coord) 2) (if (and (and (>= (- (+ (car big_center) (/ big_diameter 2)) (/ small_diameter 2)) (car small_offset_coord)) (>= (car small_offset_coord) (+ (- (car big_center) (/ big_diameter 2)) (/ small_diameter 2)))) (and (<= (+ (- (cadr big_center) (/ big_height 2)) (/ small_diameter 2)) (cadr small_offset_coord)) (<= (cadr small_offset_coord) (- (+ (cadr big_center) (/ big_height 2)) (/ small_diameter 2)))) ) (progn (setq small_circle_coord_stack (cons (list (car small_offset_coord) (cadr small_offset_coord) 0 ) small_circle_coord_stack ) ) ;(princ (list (car small_offset_coord) ; (cadr small_offset_coord) ; 0 ; )) ;(princ small_circle_coord_stack) ;(princ "ok") ) (progn ; (princ (list (car small_offset_coord) ; (cadr small_offset_coord) ; 0 ; )) ;(princ "not ok") ) ) (setq small_offset_coord (cddr small_offset_coord)) ) (setq univindex (+ 1 univindex)) ) (command "erase" ss3 "") ) (progn (setq small_offset_obj (vlax-ename->vla-object (entlast))) (vlax-put-property small_offset_obj 'Color 8) (ssadd (entlast) ss) ) ) ;(princ small_circle_coord_stack) (setq int (LM:intersections big_offset_obj small_offset_obj acextendnone)) (repeat (length int) (setq small_circle_coord_stack (cons (car int) small_circle_coord_stack)) (setq int (cdr int)) ) (setq small_circle_coord_stack (vl-sort small_circle_coord_stack '(lambda (x y) (if (eq (cadr x) (cadr y)) (< (car x) (car y)) (< (cadr x) (cadr y)) ) ;(< (cadr x) (cadr y)) ) ) ) ;(princ "\n list - ") ;(princ small_circle_coord_stack) (setq small_circle_coord '()) (setq small_circle_coord (car small_circle_coord_stack)) ) ) (if (and (/= small_circle_coord '()) (/= small_circle_coord nil)) (progn (setq small_circle_ent (entmakex (list '(0 . "CIRCLE") (cons 62 setcolor) (cons 10 small_circle_coord) (cons 40 (/ small_diameter 2)) ) ) ) (setq small_text (entmakex (list (cons 0 "TEXT") (cons 62 setcolor) (cons 11 small_circle_coord) (cons 40 (/ small_diameter 2)) (cons 1 (vl-princ-to-string (+ counter 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 71 0) (cons 72 1) (cons 73 2) ) ) ) (setq small_circle_list (cons (list small_circle_coord (/ small_diameter 2)) small_circle_list ) ) (setq small_area (+ small_area (* pi (expt (/ small_diameter 2) 2)))) (setq fill_rate (* (/ small_area big_area) 100)) (princ "\n Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (setq old_dia_for_color small_diameter) (setq counter (+ counter 1)) ) (progn) ) (if (and (> counter 0) (= small_circle_coord_stack nil)) (progn "\n OverFilling") ) ) (progn) ) (setq cable_info_list (cdr cable_info_list)) ) (if (/= ss nil) (progn (repeat (sslength ss) (setq delent (ssname ss 0)) (entdel delent) (ssdel delent ss) ) ) ) (if (/= ss3 nil) (progn (repeat (sslength ss3) (setq delent (ssname ss3 0)) (entdel delent) (ssdel delent ss3) ) ) ) (if (/= univss nil) (progn (repeat (sslength univss) (setq delent (ssname univss 0)) (entdel delent) (ssdel delent univss) ) ) ) (if (/= big_offset nil) (entdel big_offset)) (if (/= univent nil) (entdel univent)) (princ "\n Final Fill Rate = ") (princ (rtos fill_rate 2 2)) (princ " %") (vla-endundomark acdoc) (setvar 'cmdecho 1) (princ) ) ;; Gilles Chanteau- 01/01/07 ; this code is little bit modified (last 1 line) by exceed. (defun Region2Polyline (ss / *error* ss2 arcbugle acdoc space n reg norm expl olst blst dlst plst tlst blg pline ) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (princ) ) (defun arcbulge (arc) (/ (sin (/ (vla-get-TotalAngle arc) 4)) (cos (/ (vla-get-TotalAngle arc) 4))) ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace acdoc) (vla-get-ModelSpace acdoc) ) ) (setq ss2 (ssadd)) (if ss (repeat (setq i (sslength ss)) (setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i))))) (setq norm (vlax-get reg 'Normal)) (setq expl (vlax-invoke reg 'Explode)) (if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine") (= (vla-get-ObjectName x) "AcDbArc") ) ) expl ) (progn (vla-delete reg) (setq olst (mapcar '(lambda (x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint)) ) expl ) ) (while olst (setq blst nil) (if (= (vla-get-ObjectName (caar olst)) "AcDbArc") (setq blst (list (cons 0 (arcbulge (caar olst))))) ) (setq plst (cdar olst)) (setq dlst (list (caar olst))) (setq olst (cdr olst)) (while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9) (equal (last plst) (caddr x) 1e-9) ) ) olst ) ) (if (equal (last plst) (caddar tlst) 1e-9) (setq blg -1) (setq blg 1) ) (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc") (setq blst (cons (cons (1- (length plst)) (* blg (arcbulge (caar tlst))) ) blst ) ) ) (setq plst (append plst (if (minusp blg) (list (cadar tlst)) (list (caddar tlst)) ) ) ) (setq dlst (cons (caar tlst) dlst)) (setq olst (vl-remove (car tlst) olst)) ) (setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x) (setq x (trans x 0 Norm)) (list (car x) (cadr x)) ) (reverse (cdr (reverse plst))) ) ) ) ) (vla-put-Closed pline :vlax-true) (mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst) (vla-put-Elevation pline (caddr (trans (car plst) 0 Norm))) (vla-put-Normal pline (vlax-3d-point Norm)) (mapcar 'vla-delete dlst) (ssadd (vlax-vla-object->ename pline) ss2) ;added line ;(princ pline) ;added line ;(princ (sslength ss2)) ;added line ) ) (progn (ssadd (vlax-vla-object->ename expl) ss2) ;added line (mapcar 'vla-delete expl) ) ) ) ) ss2 ;added line ) (defun ex:ESMAKE () (setq excelapp (vlax-get-or-create-object "Excel.Application")) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) (vlax-put Excelapp "visible" :vlax-true) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq xlcols (vlax-get-property acsheet 'Columns)) (setq xlrows (vlax-get-property acsheet 'Rows)) (setq cell (vlax-get-property acsheet 'Cells)) ) (defun ex:RELEASEEXCEL (/) (if (= AcSheet nil) (progn) (progn (vlax-release-object AcSheet) ;(princ "\n Acsheet Release for next time. Complete.") ) ) (if (= Sheets nil) (progn) (progn (vlax-release-object Sheets) ;(princ "\n Sheets Release for next time. Complete.") ) ) (if (= Workbooks nil) (progn) (progn (vlax-release-object Workbooks) ;(princ "\n Workbooks Release for next time. Complete.") ) ) (if (= ExcelApp nil) (progn) (progn (vlax-release-object ExcelApp) ;(princ "\n ExcelApp Release for next time. Complete.") ) ) ) (defun ex:ECBORDERBYADDR (cell brdi ltype lweight lcolor / brds tmp) (setq brds (vlax-get-property cell 'borders)) (foreach i brdi (setq tmp (vlax-get-property brds 'Item i)) (if lweight (vlax-put-property tmp 'Weight lweight) ) (if ltype (vlax-put-property tmp 'LineStyle ltype) ) (if lcolor (vlax-put-property tmp 'ColorIndex lcolor) ) ) ) (defun ex:ECSELPUT (r c textstring / tc addr rng textstring2) (setq tc (Number2Alpha c)) (setq addr (strcat tc (itoa r) ":" tc (itoa r))) (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-invoke rng 'Select) (setq textstring2 textstring) (vlax-put-property cell 'item r c textstring2) ) (defun c:ConduitFillListSample (/ *error* samplelist indexr indexc samplelista textstring xlcolumns bordercells colorcells ) (setvar 'cmdecho 0) (defun *error* (msg) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (ex:RELEASEEXCEL) (setvar "cmdecho" 1) (princ) ) (ex:ESMAKE) (setq samplelist (list (list "Command" "ConduitSize" "Cable No." "100-AAA-001" "101-BBB-002" "102-CCC-003" "103-DDD-004" "104-EEE-005" "105-FFF-006" "106-GGG-007" "107-HHH-008" "108-III-009" "109-JJJ-010" "110-KKK-011" "111-LLL-012" "112-MMM-013" "113-NNN-014" ) (list "ConduitFillList" "100" "Cable O.D." "30" "30" "30" "20" "20" "20" "20" "20" "10" "10" "10" "10" "10" "10" ) (list "") (list "Command" "Tray Width" "Tray Height" "Cable No." "100-AAA-001" "101-BBB-002" "102-CCC-003" "103-DDD-004" "104-EEE-005" "105-FFF-006" "106-GGG-007" "107-HHH-008" "108-III-009" "109-JJJ-010" "110-KKK-011" "111-LLL-012" "112-MMM-013" "113-NNN-014" ) (list "TrayFillList" "900" "150" "Cable O.D." "30" "30" "30" "20" "20" "20" "20" "20" "10" "10" "10" "10" "10" "10" ) (list "") ) ) (setq indexr 3) (setq indexc 2) (repeat (length samplelist) (setq samplelista (nth (- indexc 2) samplelist)) (setq indexr 3) (repeat (length samplelista) (setq textstring (nth (- indexr 3) samplelista)) (ex:ECSELPUT indexr indexc textstring) (setq indexr (+ indexr 1)) ) ;end of repeat rows (setq indexc (+ indexc 1)) ) ;end of repeat columns (setq xlcolumns (vlax-get-property acsheet 'Columns)) (vlax-invoke-method xlcolumns 'AutoFit) (setq bordercells (vlax-get-property acsheet 'Range "B3:C19,E3:F20")) (ex:ECBORDERBYADDR bordercells '(1 2 3 4) 1 2 23) (setq colorcells (vlax-get-property acsheet 'Range "B3:B5,C5,E3:E6,F6")) (vlax-put-property (vlax-get-property colorcells "Interior") "Colorindex" (vlax-make-variant 37) ) (ex:ECSELPUT 1 2 "How to - Copy B3~C19 or E3~F20 and input each command in cad.") (ex:RELEASEEXCEL) (setvar 'cmdecho 1) (princ) ) ;(defun c:r2ptest () ; (setq ss (ssget)) ; (setq ss2 (region2polyline ss)) ; (sssetfirst nil ss2) ; (princ) ;) ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections (ob1 ob2 mod / lst rtn) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;; String to List - Lee Mac ;; Separates a string using a given delimiter ;; str - [str] String to process ;; del - [str] Delimiter by which to separate the string ;; Returns: [lst] List of strings (defun LM:str->lst (str del / pos) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (defun @GetClipBoardText (/ htmlfile txtstring) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData ) 'GetData "Text" ) ) txtstring ;(vlax-release-object htmlfile) ) edited 20230801 1. Modified to not use the bypass method using layers 2. For certain isolated areas, there is still a bug where edges cannot be recognized. occurring at non-points between arcs or Common intersections. 3. I would appreciate it if someone could tell me how to make it without using command "union" edited 20230801-2 add command for multiple quantity input, by excel and tray mode. I think a pentagonal hexagon would be easy as well. Because this doesn't compute the optimal placement Edited August 1, 2023 by exceed Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted July 31, 2023 Share Posted July 31, 2023 At first glance ... You got this line twice, 1st time in the error function, then at towards the end of the function: (command "-LAYDEL" "Name" "Conduit_Offset_Temp" "" "Yes") All the temporary circles are drawn in that layer. So then at the end you delete that layer and anything drawn on it. The problem: you can't delete a layer that is set current. First you need to switch layer, for example to layer "0" So do this around line 132: (setvar 'clayer "0") (command "-LAYDEL" "Name" "Conduit_Offset_Temp" "" "Yes") Again, that's just at first glance, if this doesn't help I can see more thoroughly 1 Quote Link to comment Share on other sites More sharing options...
exceed Posted July 31, 2023 Author Share Posted July 31, 2023 4 minutes ago, Emmanuel Delay said: At first glance ... You got this line twice, 1st time in the error function, then at towards the end of the function: (command "-LAYDEL" "Name" "Conduit_Offset_Temp" "" "Yes") All the temporary circles are drawn in that layer. So then at the end you delete that layer and anything drawn on it. The problem: you can't delete a layer that is set current. First you need to switch layer, for example to layer "0" So do this around line 132: (setvar 'clayer "0") (command "-LAYDEL" "Name" "Conduit_Offset_Temp" "" "Yes") Again, that's just at first glance, if this doesn't help I can see more thoroughly oh, my mistake thank you for help 1 Quote Link to comment Share on other sites More sharing options...
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.