exceed Posted April 25, 2022 Posted April 25, 2022 (edited) ; Cable Tray Cable Section - 2022.04.25 exceed ; this is Simple lisp for 'draw the section of tray & cables' ; tray width is user input ; tray height is 150 fixed, lung space 20 is also fixed. (vl-load-com) (defun c:CTCS ( / *error* traywidth trayheight traylung basept baseptx numberyn cablestartptx cablestartpty widthlimit heightlimit returnx maxodin1layer cablemm2 cablemm2sum index cableqty cableod cablecenterpt traymm2 index2 ) (setvar 'cmdecho 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ "\n Cable Space = ") (princ cablemm2sum) (princ " mm^2 / ") (princ "Tray Space = ") (princ traymm2) (princ " mm^2 = ") (princ (rtos (* (/ cablemm2sum traymm2) 100) 2 2)) (princ " %") (setvar 'cmdecho 1) (princ) ) (setq traywidth (getreal "\n Input Tray Width (150/300/600/900) = ")) (setq trayheight 150) (setq traylung 20) (setq traymm2 0) (setq traymm2 (* (- trayheight traylung) traywidth)) (setq basept (getpoint "\n pick point for tray = ")) (setq baseptx (car basept)) (setq basepty (cadr basept)) (princ (list baseptx basepty)) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 25) (+ basepty 5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 25) (+ basepty traylung))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 25) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 20) (+ basepty 5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 20) (+ basepty 145))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 145))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 150))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 25) (+ basepty 150))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 25) (+ basepty traylung))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 25)) (+ basepty traylung))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 25)) (+ basepty 150))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 50)) (+ basepty 150))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 50)) (+ basepty 145))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 30)) (+ basepty 145))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 30)) (+ basepty 5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 50)) (+ basepty 5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 50)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 25)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 25)) (+ basepty traylung))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth 25)) (+ basepty 5))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq numberyn (getstring "\n Place Number to Cables? (Y/N)")) (setq cablestartptx (+ baseptx 25)) (setq cablestartpty (+ basepty traylung)) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight traylung))) (setq returnx cablestartptx) (setq maxodin1layer 0) (setq cablemm2 0) (setq cablemm2sum 0) (setq index 0) ;repeat index for numbering (setq index2 0) ;while index for coloring (while (setq cableod (getreal "\n Input Cable O.D. = ")) (setq cableqty (getint "\n Input Cable Q'ty = ")) (setq cablemm2 (* cableod cableod)) (repeat cableqty (if (> cableod maxodin1layer) (setq maxodin1layer cableod) ) (if (> (+ cablestartpty cableod) heightlimit) (princ "\n It's overload") ) (setq cablecenterpt (list (+ cablestartptx (/ cableod 2)) (+ cablestartpty (/ cableod 2)) 0 )) (entmake (list '(0 . "CIRCLE") (cons 8 "0") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 62 (+ index2 1)) )) (if (= (strcase numberyn) "Y") (entmake (list '(0 . "TEXT") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 1 (vl-princ-to-string (+ index 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 cablecenterpt) (cons 100 "AcDbText") (cons 73 2) (cons 62 (+ index2 1)) )) ) (setq cablestartptx (+ cablestartptx cableod)) (setq cablemm2sum (+ cablemm2sum cablemm2)) (if (> (+ cablestartptx cableod) widthlimit) (progn (setq cablestartpty (+ cablestartpty maxodin1layer)) (setq cablestartptx returnx) (setq maxodin1layer 0) ) ) (setq index (+ index 1)) );end of repeat (setq index2 (+ index2 1)) );end of while (*error*) (princ) );end of defun ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) this time, I practiced 'while'. draw a cross section of the 1ea ladder cable tray, and fill the cables with od and quantity. - the cable area was calculated as a rectangle rather than a circle for unusable space. - the highest od on one floor becomes the bottom of the next floor. to improve this i think 1. I have to study the 'Bin Packing Problem' It is expected to be quite quite difficult. - If there is an example of solving BPP with lisp, please let me know. That's also why I wrote this. 2. it can be developed by taking the cable name and od from Excel and making it into a table 3. visualize the floor area ratio calculation using a hatch I didn't do the 2 and 3, because I didn't need them for my work this time. Edited April 25, 2022 by exceed 2 Quote
Steven P Posted April 25, 2022 Posted April 25, 2022 Nice, never thought about drawing cable tray with a LISP like that, I have LISPs to draw common blocks, quicker to insert using keywords rather than pop ups, I might borrow what you have done. For power cables we often install them in trefoil arrangement - something in the back of my mind to create one day though it is just 3 circles, and we will often have a spacing between groups of power cables, not sure if that is also something to consider here? 1 Quote
Tharwat Posted April 25, 2022 Posted April 25, 2022 Good presentation @exceed A few notes if you would like to improve your routine a bit better. 1- You don't need to the CMDECHO system variable nor assuming all users have it set with one. 2- Always wrap your user inputs with AND function to avoid error and failure when a user hits enter or might enter different value far from the message you asked them to go with. 3- The Calcs you did in error function also should check for valid value and for assigned variables in prior of processing any prints to command line. 4- Your error function requires one argument to avoid an error message: Two few arguments. 1 Quote
BIGAL Posted April 26, 2022 Posted April 26, 2022 A couple more suggestions I would add dcls for your input maybe start with this. (setq traywidth (getreal "\n Input Tray Width (150/300/600/900) = ")) (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (if (= but nil)(setq but 1)) (setq traywidth (atof (ah:butts but "V" '("Choose a width " "150" "300" "600" "900")))) (setq numberyn (getstring "\n Place Number to Cables? (Y/N)")) (setq numberyn (ah:butts but "H" '("Cable number Y/N " "Y" "N"))) (while (setq cableod (getreal "\n Input Cable O.D. = ")) (setq cableqty (getint "\n Input Cable Q'ty = ")) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (while (setq ans (AH:getvalsm (list "Enter values " "Input Cable O.D. " 5 4 "6" "Input Cable Q'ty" 5 4 "1" ))) (setq cableod (atof (car ans)) cableqty (atoi (cadr ans))) If you change this (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) to a filename then you can see the dcl code produced and use that to make a custom dcl within your code. I have multi column radio button but only 2 columns need to have 3 for you. Working on a new version as many columns as required. Oh yeah have make a entmake a circle block with text inside if you want, just ask. Multi GETVALS.lspMulti radio buttons.lsp 2 1 Quote
exceed Posted April 26, 2022 Author Posted April 26, 2022 (edited) ; Cable Tray Cable Section - 2022.04.27 exceed ; this is Simple lisp for 'draw the section of tray & cables' ; tray width is user input ; command list ; CTCSI = make ladder tray with inside rail ; CTCSO = make ladder tray with outside rail ; CTCSP = make perforated tray ; CTCSL = make tray with just simple line ; CTCSL = make tray with just simple rectangle ; EXCTCS = get tray&cable data from excel by clipboard ; EXCTCSSAMPLE = make me sample excel file for EXCTCS (vl-load-com) (defun c:CTCSI ( / traytype ) (setq traytype "I") (ex:CTCS traytype) (princ) ) (defun c:CTCSO ( / traytype ) (setq traytype "O") (ex:CTCS traytype) (princ) ) (defun c:CTCSP ( / traytype ) (setq traytype "P") (ex:CTCS traytype) (princ) ) (defun c:CTCSL ( / traytype ) (setq traytype "L") (ex:CTCS traytype) (princ) ) (defun c:CTCSR ( / traytype ) (setq traytype "R") (ex:CTCS traytype) (princ) ) (defun c:EXCTCS ( / traytype ) (setq traytype "P") (ex:EXCTCS traytype) (princ) ) (defun ex:CTCS ( traytype / *error* traywidth trayheight traylung basept baseptx numberyn cablestartptx cablestartpty widthlimit heightlimit returnx maxodin1layer cablemm2 cablemm2sum index cableqty cableod cablecenterpt traymm2 index2 platedepth railwidth) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (LM:startundo (LM:acdoc)) (setq basept (getpoint "\n pick point for tray (bottom center) = ")) (setq baseptx (car basept)) (setq basepty (cadr basept)) (princ (list baseptx basepty)) (setq traywidth (getreal "\n Input Tray Width (ex - 150/200/300/450/600/900/1200) = ")) (setq trayheight 150) (setq traylung 15) (setq platedepth 5) (setq railwidth 20) (setq traymm2 0) (cond ((= (strcase traytype) "O") (progn (setq baseptx (- baseptx (+ (+ (/ traywidth 2) railwidth) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx railwidth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx railwidth) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth (* platedepth 2)))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth (* platedepth 2)))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight (+ traylung platedepth)) traywidth)) (setq cablestartptx (+ baseptx (+ railwidth platedepth))) (setq cablestartpty (+ basepty (+ traylung platedepth))) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight (+ traylung platedepth)))) ); end of progn ); end of cond case 1 outside rail ladder tray ((= (strcase traytype) "I") (progn (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight (+ traylung platedepth)) traywidth)) (setq cablestartptx (+ baseptx platedepth)) (setq cablestartpty (+ basepty (+ traylung platedepth))) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- (- trayheight (+ traylung platedepth)) platedepth))) ); end of progn ); end of cond case 2 inside rail ladder tray ((= (strcase traytype) "P") (progn (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight platedepth) traywidth)) (setq cablestartptx (+ baseptx platedepth)) (setq cablestartpty (+ basepty platedepth)) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight platedepth))) ); end of progn ); end of cond case 3 perforated tray ((= (strcase traytype) "L") (progn (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* trayheight traywidth)) (setq cablestartptx baseptx) (setq cablestartpty basepty) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty trayheight)) ); end of progn ); end of cond case 4 simple line ((= (strcase traytype) "R") (progn (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* trayheight traywidth)) (setq cablestartptx baseptx) (setq cablestartpty basepty) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty trayheight)) ); end of progn ); end of cond case 5 simple rectangle );end of cond (setq numberyn (getstring "\n Place Number to Cables? (Press Anykey = Yes / N = No) = ")) (setq returnx cablestartptx) (setq maxodin1layer 0) (setq cablemm2 0) (setq cablemm2sum 0) (setq index 0) ;repeat index for numbering (setq index2 0) ;while index for coloring (while (setq cableod (getreal "\n Input Cable O.D. = ")) (setq cableqty (getint "\n Input Cable Q'ty = ")) (setq cablemm2 (* cableod cableod)) (repeat cableqty (if (> cableod maxodin1layer) (setq maxodin1layer cableod) ) (if (> (+ cablestartpty cableod) heightlimit) (princ "\n It's overload") ) (setq cablecenterpt (list (+ cablestartptx (/ cableod 2)) (+ cablestartpty (/ cableod 2)) 0 )) (entmake (list '(0 . "CIRCLE") (cons 8 "0") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 62 (+ index2 1)) )) (if (/= (strcase numberyn) "N") (entmake (list '(0 . "TEXT") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 1 (vl-princ-to-string (+ index 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 cablecenterpt) (cons 100 "AcDbText") (cons 73 2) (cons 62 (+ index2 1)) )) ) (setq cablestartptx (+ cablestartptx cableod)) (setq cablemm2sum (+ cablemm2sum cablemm2)) (if (> (+ cablestartptx cableod) widthlimit) (progn (setq cablestartpty (+ cablestartpty maxodin1layer)) (setq cablestartptx returnx) (setq maxodin1layer 0) ) ) (setq index (+ index 1)) );end of repeat (princ "\n [ Cable Space = ") (princ cablemm2sum) (princ " mm^2 / ") (princ "Tray Space = ") (princ traymm2) (princ " mm^2 ] = Fill Ratio ") (princ (rtos (* (/ cablemm2sum traymm2) 100) 2 2)) (princ " %") (setq index2 (+ index2 1)) );end of while (LM:endundo (LM:acdoc)) (princ) );end of defun (defun ex:EXCTCS ( traytype / *error* traywidth trayheight traylung basept baseptx numberyn cablestartptx cablestartpty widthlimit heightlimit returnx maxodin1layer cablemm2 cablemm2sum index cableqty cableod cablecenterpt traymm2 index2 platedepth railwidth) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (LM:startundo (LM:acdoc)) (defun mysort ( l ) (vl-sort l '(lambda ( a b ) (if (eq (car a) (car b)) (< (caddr a) (caddr b)) (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b))) ) ) ) ) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'GetData "Text")) ;(princ "\n original clipboard text - \n") ;(print txtstring) (setq txtedit1 (LM:str->lst txtstring "\r\n")) ;(princ "\n line break text - \n") ;(print txtedit1) (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)) ;(princ "\n selectedrow - ") ;(print selectedrow) (setq selectedrowlist (LM:str->lst selectedrow "\t")) ;(princ "/ selectedrowlist - ") ;(print selectedrowlist) (setq srllen (length selectedrowlist)) ;(princ "/ srllen - ") ;(princ srllen) (setq subindex 0) (repeat srllen (setq selectedcell (nth subindex selectedrowlist)) (setq sclist '()) (setq sclist (list index selectedcell subindex)) (setq scstack (cons sclist scstack)) (setq subindex (+ subindex 1)) );end of repeat (setq index (+ index 1)) ) ;(princ "\n scstack - ") ;(princ scstack) (setq ss1stacklist (mysort scstack)) ;(princ "\n sorted scstack - ") ;(princ scstack) (setq trayname (cadr (nth 1 ss1stacklist))) (setq traytype (cadr (nth 3 ss1stacklist))) (setq traywidth (atof (vl-princ-to-string (cadr (nth 5 ss1stacklist))))) (setq ss1stacklist (cddddr (cddddr ss1stacklist))) ;(princ ss1stacklist) (setq ss1count (length ss1stacklist)) (setq index3 0) (setq cableinfofromexcel '()) (setq cableinfo1line '()) (repeat (/ ss1count 2) (setq cableodfromexcel (atof (vl-princ-to-string (cadr (nth (+ index3 1) ss1stacklist))))) (setq cablenofromexcel (cadr (nth index3 ss1stacklist))) (setq cableinfo1line (list cableodfromexcel cablenofromexcel)) (setq cableinfofromexcel (cons cableinfo1line cableinfofromexcel)) (setq index3 (+ index3 2)) );end of repeat (setq cableinfofromexcel (vl-sort cableinfofromexcel (function (lambda (x1 x2)(> (car x1) (car x2))) ) ) ) ;(princ cableinfofromexcel) (setq basept (getpoint "\n pick point for tray (bottom center) = ")) (setq baseptx (car basept)) (setq basepty (cadr basept)) (princ (list baseptx basepty)) ;(setq traywidth (getreal "\n Input Tray Width (ex - 150/200/300/450/600/900/1200) = ")) (setq trayheight 150) (setq traylung 15) (setq platedepth 5) (setq railwidth 20) (setq traymm2 0) (cond ((= (strcase traytype) "O") (progn (setq traytypedesc "Ladder Tray - Outside Rail") (setq baseptx (- baseptx (+ (+ (/ traywidth 2) railwidth) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx railwidth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx railwidth) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth (* platedepth 2)))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth (* platedepth 2)))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight (+ traylung platedepth)) traywidth)) (setq cablestartptx (+ baseptx (+ railwidth platedepth))) (setq cablestartpty (+ basepty (+ traylung platedepth))) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight (+ traylung platedepth)))) ); end of progn ); end of cond case 1 outside rail ladder tray ((= (strcase traytype) "I") (progn (setq traytypedesc "Ladder Tray - Inside Rail") (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight (+ traylung platedepth)) traywidth)) (setq cablestartptx (+ baseptx platedepth)) (setq cablestartpty (+ basepty (+ traylung platedepth))) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- (- trayheight (+ traylung platedepth)) platedepth))) ); end of progn ); end of cond case 2 inside rail ladder tray ((= (strcase traytype) "P") (progn (setq traytypedesc "Perforated Tray") (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight platedepth) traywidth)) (setq cablestartptx (+ baseptx platedepth)) (setq cablestartpty (+ basepty platedepth)) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight platedepth))) ); end of progn ); end of cond case 3 perforated tray ((= (strcase traytype) "L") (progn (setq traytypedesc "Tray - Simple Line") (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* trayheight traywidth)) (setq cablestartptx baseptx) (setq cablestartpty basepty) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty trayheight)) ); end of progn ); end of cond case 4 simple line ((= (strcase traytype) "R") (progn (setq traytypedesc "Tray - Simple Rectangle") (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* trayheight traywidth)) (setq cablestartptx baseptx) (setq cablestartpty basepty) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty trayheight)) ); end of progn ); end of cond case 5 simple rectangle );end of cond (setq numberyn (getstring "\n Place Number to Cables? (Press Anykey = Yes / N = No) = ")) (setq returnx cablestartptx) (setq maxodin1layer 0) (setq cablemm2 0) (setq cablemm2sum 0) (setq index 0) ;repeat index for numbering (setq index2 -1) ;while index for coloring (setq oldcableod 0) (setq cinfolen (length cableinfofromexcel)) (repeat cinfolen (setq cablename (cdr (nth index cableinfofromexcel))) (setq cableod (atof (vl-princ-to-string (car (nth index cableinfofromexcel))))) (if (/= oldcableod cableod) (progn (setq oldcableod cableod) (setq index2 (+ index2 1)) ) );end of if (if (> cableod maxodin1layer) (setq maxodin1layer cableod) ) (if (> (+ cablestartpty cableod) heightlimit) (princ "\n It's overload") ) (setq cablecenterpt (list (+ cablestartptx (/ cableod 2)) (+ cablestartpty (/ cableod 2)) 0 )) (entmake (list '(0 . "CIRCLE") (cons 8 "0") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 62 (+ index2 1)) )) (if (/= (strcase numberyn) "N") (entmake (list '(0 . "TEXT") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 1 (vl-princ-to-string (+ index 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 cablecenterpt) (cons 100 "AcDbText") (cons 73 2) (cons 62 (+ index2 1)) )) ) (setq cablestartptx (+ cablestartptx cableod)) (setq cablemm2 (* cableod cableod)) (setq cablemm2sum (+ cablemm2sum cablemm2)) (if (> (+ cablestartptx cableod) widthlimit) (progn (setq cablestartpty (+ cablestartpty maxodin1layer)) (setq cablestartptx returnx) (setq maxodin1layer 0) ) ) (setq cablefillratio (rtos (* (/ cablemm2sum traymm2) 100) 2 2)) (princ "\n [ Cable Space = ") (princ cablemm2sum) (princ " mm^2 / ") (princ "Tray Space = ") (princ traymm2) (princ " mm^2 ] = Fill Ratio ") (princ cablefillratio) (princ " %") (setq index (+ index 1)) );end of repeat (setq tablept (getpoint "\n Pick Point for Table = ")) (princ tablept) (setq infolst (list "Tray No." trayname "___" "Tray Type" traytypedesc traytype "Tray Width" traywidth "mm" "Cable Area" cablemm2sum "mm^2" "Tray Area" traymm2 "mm^2" "Cable Fill Ratio" cablefillratio "%" " " " " " " "No." "Cable Name" "Cable O.D.")) (sct tablept infolst cableinfofromexcel) (LM:endundo (LM:acdoc)) (princ) );end of defun (defun c:EXCTCSSAMPLE ( / *error* samplist 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 "Tray No." "Tray Type" "Tray Width" "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" "114-OOO-015" "115-PPP-016" "116-QQQ-017" "117-RRR-018" "118-SSS-019" "119-TTT-020" "120-UUU-021" "121-VVV-022" "122-WWW-023" "123-XXX-024") (list "1111-CT-0001" "O" "600" "Cable O.D." "30" "30" "35" "24.5" "18.5" "35" "35" "35" "31.5" "32.5" "31.5" "31.5" "36" "30" "32.5" "22" "27.5" "17.5" "30" "30" "35" "24.5" "18.5" "35") (list "") (list "Tray No." "Tray Type" "Tray Width" "Cable No." "137-LLL-038" "138-MMM-039" "139-NNN-040" "140-OOO-041" "141-PPP-042" "142-QQQ-043" "143-RRR-044" "144-SSS-045" "145-TTT-046" "146-UUU-047" "147-VVV-048" "148-WWW-049" "149-XXX-050" "150-YYY-051" "151-ZZZ-052" "152-AAA-053" "153-BBB-054" "154-CCC-055" "155-DDD-056" "156-EEE-057" "157-FFF-058" "158-GGG-059" "159-HHH-060" "160-III-061" "161-JJJ-062" "162-KKK-063" "163-LLL-064") (list "1234-CT-0002" "I" "900" "Cable O.D." "31" "31" "31" "23" "21" "14.5" "31" "31" "31" "31" "23" "21" "14.5" "31" "31" "31" "31" "23" "21" "14.5" "31" "22.5" "26" "22.5" "26" "13" "18.5") (list "") (list "Tray No." "Tray Type" "Tray Width" "Cable No." "181-DDD-082" "182-EEE-083" "183-FFF-084" "184-GGG-085" "185-HHH-086" "186-III-087" "187-JJJ-088" "188-KKK-089" "189-LLL-090" "190-MMM-091" "191-NNN-092" "192-OOO-093" "193-PPP-094" "194-QQQ-095" "195-RRR-096" "196-SSS-097" "197-TTT-098" "198-UUU-099" "199-VVV-100" "200-WWW-101" "201-XXX-102" "202-YYY-103" "203-ZZZ-104" "203-AAA-104") (list "4567-CT-0003" "P" "200" "Cable O.D." "26" "22.5" "22.5" "35" "22.5" "31" "31" "35" "23" "23" "23" "23" "26" "22.5" "13" "26" "22.5" "22.5" "35" "22.5" "31" "31" "35" "23") )) (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:C30,E3:F33,H3:I30")) (pl:cell-border-fill bordercells '(1 2 3 4) 1 2 23) (setq colorcells (vlax-get-property acsheet 'Range "B3:B6,C6,E3:E6,F6,H3:H6,I6")) (vlax-put-property (vlax-get-property colorcells "Interior") "Colorindex" (vlax-make-variant 37)) (ex:ECSELPUT 1 2 "How to do - Copy B3~C30 then run EXCTCS in CAD") (ex:RELEASEEXCEL) (setvar 'cmdecho 1) (princ) );end of defun (defun ex:ESMAKE ( / ) ;from BIGAL's ah:chkexcel (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 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:ECSELPUT ( r c textstring / c addr c1 c2 c3 rng textstring2 ) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (setq c (+ c 1)) (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-invoke rng 'Select) (setq textstring2 textstring) ;(setq textstring2 (strcat "'" textstring)) (vlax-put-property cell 'item r c textstring2) ) ; by Alaspher https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/make-border-to-an-excel-cell/m-p/1362660/highlight/true#M183776 (defun pl:cell-border-fill (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) ) ) ) ; by BIGAL https://www.cadtutor.net/forum/topic/50401-entmake-table-with-autolisp/?do=findComment&comment=418519 ; example of creating a table (defun sct ( pt infolst lst / colwidth numcolumns numrows objtable rowheight sp vgad vgao ) (vl-load-com) (setq sp (vlax-3d-point pt)) (setq doc (vla-get-activedocument (vlax-get-acad-object) )) (setq vgms (vla-get-modelspace doc)) (setq numrows (+ (length lst) 9)) (setq numcolumns (+ (length (car lst)) 1)) (setq rowheight 40) (setq colwidth 300) (setq tabletxtheight (* rowheight 0.5)) (setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth)) (vla-put-RegenerateTableSuppressed objtable :vlax-True) (vla-setalignment objtable (+ acDataRow acHeaderRow) acMiddleCenter) (vla-settextheight objtable (+ acDataRow acHeaderRow) tabletxtheight) (vla-setcolumnwidth objtable 0 (* (* colwidth 3) 0.3)) (vla-setcolumnwidth objtable 1 (* (* colwidth 3) 0.4)) (vla-setcolumnwidth objtable 2 (* (* colwidth 3) 0.3)) (vla-settext objtable 0 0 "Cable Tray Details") (setq indexinfo 0) (setq indexinfo2 0) (repeat (/ (length infolst) 3) (vla-settext objtable (+ indexinfo2 1) 0 (nth indexinfo infolst)) (vla-settext objtable (+ indexinfo2 1) 1 (nth (+ indexinfo 1) infolst)) (vla-settext objtable (+ indexinfo2 1) 2 (nth (+ indexinfo 2) infolst)) (setq indexinfo (+ indexinfo 3)) (setq indexinfo2 (+ indexinfo2 1)) ) (setq index1 9) (setq index2 0) (repeat numrows (vla-settext objtable index1 index2 (- index1 8)) (vla-settext objtable index1 (+ index2 1) (vl-princ-to-string (cadr (nth (- index1 9) lst)))) (vla-settext objtable index1 (+ index2 2) (vl-princ-to-string (car (nth (- index1 9) lst)))) (setq index1 (+ index1 1)) );end of repeat (vla-deleterows objtable 0 1) (vl-catch-all-apply 'vlax-invoke (list objtable 'MergeCells 0 0 1 2) ) (vl-catch-all-apply 'vlax-invoke (list objtable 'MergeCells 6 6 0 2) ) (vla-put-RegenerateTableSuppressed objtable :vlax-False) (princ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) On 4/26/2022 at 5:13 AM, Tharwat said: Good presentation @exceed A few notes if you would like to improve your routine a bit better. 1- You don't need to the CMDECHO system variable nor assuming all users have it set with one. 2- Always wrap your user inputs with AND function to avoid error and failure when a user hits enter or might enter different value far from the message you asked them to go with. 3- The Calcs you did in error function also should check for valid value and for assigned variables in prior of processing any prints to command line. 4- Your error function requires one argument to avoid an error message: Two few arguments. I update code like this as your notes as i possible. thanks for your help! - removed setvar cmdecho - removed the one used as (*error*) at the end of the function. I saw someone use error msg function at the same time by putting *error* at the end of the routine and I imitated it. - wrapping the user input with and was reflected by dividing the command and changing yes to press any key. and add some minor edit 1. devide command CTCSO - outside rail ladder tray (left of gif) CTCSI - inside rail ladder tray (center of gif) CTCSP - perforated tray (right of gif) 2. use variable - trayheight, traylung, platedepth, railwidth default value : trayheigth = 150, traylung = 15, platedepth = 5, railwidth 20 I changed these from fixed number to variable, but I didn't make it user input to minimize user input. 3. print area ratio was changed to be calculated for each O.D. input. 4. since there is the thickness of the steel plate and width of rail, so changed based on the bottom center. like 3d modeling On 4/25/2022 at 7:19 PM, Steven P said: Nice, never thought about drawing cable tray with a LISP like that, I have LISPs to draw common blocks, quicker to insert using keywords rather than pop ups, I might borrow what you have done. For power cables we often install them in trefoil arrangement - something in the back of my mind to create one day though it is just 3 circles, and we will often have a spacing between groups of power cables, not sure if that is also something to consider here? I am not major in elec., but it seems that most of the trefoil cables are installed in 1 stage in tray. It seems possible to implement it because it is not necessary to think about the y-axis. In the step of inputting cable od, it would be good to add an option to input trefoil and empty gap. This is possible because the routine goes from left to right linearly. It is also worth considering the ability to add a separator and divide the space into two or three. In this case, the complexity will increase, but since it is used a lot in actual work... On 4/26/2022 at 9:28 AM, BIGAL said: A couple more suggestions I would add dcls for your input maybe start with this. (setq traywidth (getreal "\n Input Tray Width (150/300/600/900) = ")) (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (if (= but nil)(setq but 1)) (setq traywidth (atof (ah:butts but "V" '("Choose a width " "150" "300" "600" "900")))) (setq numberyn (getstring "\n Place Number to Cables? (Y/N)")) (setq numberyn (ah:butts but "H" '("Cable number Y/N " "Y" "N"))) (while (setq cableod (getreal "\n Input Cable O.D. = ")) (setq cableqty (getint "\n Input Cable Q'ty = ")) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (while (setq ans (AH:getvalsm (list "Enter values " "Input Cable O.D. " 5 4 "6" "Input Cable Q'ty" 5 4 "1" ))) (setq cableod (atof (car ans)) cableqty (atoi (cadr ans))) If you change this (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) to a filename then you can see the dcl code produced and use that to make a custom dcl within your code. I have multi column radio button but only 2 columns need to have 3 for you. Working on a new version as many columns as required. Oh yeah have make a entmake a circle block with text inside if you want, just ask. Multi GETVALS.lsp 2.75 kB · 26 downloads Multi radio buttons.lsp 3.38 kB · 12 downloads Thanks for your opinions. Dcl was not applied to this routine because it was considered to input tray quickly or to work with excel. but Most of the time dcl makes the program Complete, (but I haven't mastered it). So your code is very helpful to me! ================================================================================================ edit 1 Added a function to receive input from Excel. This is the use of this feature of BIGAL. thank you. This Lisp uses text from the clipboard, not a range selection. Therefore, it works if you copy the table in the format shown in the figure below from Excel and enter EXCTCS. - tray no. - tray type : O = outside rail ladder tray, I = inside rail ladder tray, P = perforated tray - The number of cables can be added at will. ================================================================================================ edit 2 - add tray shape : simple line, simple rectangle command : CTCSL, CTCSR EXCTCS tray type code "L", "R" - edit typo : platedepth ================================================================================================ edit 3 - add function : make sample excel file for EXCTCS command : EXCTCSSAMPLE Edited April 27, 2022 by exceed 1 1 Quote
juanfran Posted October 30 Posted October 30 On 4/26/2022 at 3:45 AM, exceed said: ; Cable Tray Cable Section - 2022.04.27 exceed ; this is Simple lisp for 'draw the section of tray & cables' ; tray width is user input ; command list ; CTCSI = make ladder tray with inside rail ; CTCSO = make ladder tray with outside rail ; CTCSP = make perforated tray ; CTCSL = make tray with just simple line ; CTCSL = make tray with just simple rectangle ; EXCTCS = get tray&cable data from excel by clipboard ; EXCTCSSAMPLE = make me sample excel file for EXCTCS (vl-load-com) (defun c:CTCSI ( / traytype ) (setq traytype "I") (ex:CTCS traytype) (princ) ) (defun c:CTCSO ( / traytype ) (setq traytype "O") (ex:CTCS traytype) (princ) ) (defun c:CTCSP ( / traytype ) (setq traytype "P") (ex:CTCS traytype) (princ) ) (defun c:CTCSL ( / traytype ) (setq traytype "L") (ex:CTCS traytype) (princ) ) (defun c:CTCSR ( / traytype ) (setq traytype "R") (ex:CTCS traytype) (princ) ) (defun c:EXCTCS ( / traytype ) (setq traytype "P") (ex:EXCTCS traytype) (princ) ) (defun ex:CTCS ( traytype / *error* traywidth trayheight traylung basept baseptx numberyn cablestartptx cablestartpty widthlimit heightlimit returnx maxodin1layer cablemm2 cablemm2sum index cableqty cableod cablecenterpt traymm2 index2 platedepth railwidth) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (LM:startundo (LM:acdoc)) (setq basept (getpoint "\n pick point for tray (bottom center) = ")) (setq baseptx (car basept)) (setq basepty (cadr basept)) (princ (list baseptx basepty)) (setq traywidth (getreal "\n Input Tray Width (ex - 150/200/300/450/600/900/1200) = ")) (setq trayheight 150) (setq traylung 15) (setq platedepth 5) (setq railwidth 20) (setq traymm2 0) (cond ((= (strcase traytype) "O") (progn (setq baseptx (- baseptx (+ (+ (/ traywidth 2) railwidth) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx railwidth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx railwidth) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth (* platedepth 2)))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth (* platedepth 2)))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight (+ traylung platedepth)) traywidth)) (setq cablestartptx (+ baseptx (+ railwidth platedepth))) (setq cablestartpty (+ basepty (+ traylung platedepth))) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight (+ traylung platedepth)))) ); end of progn ); end of cond case 1 outside rail ladder tray ((= (strcase traytype) "I") (progn (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight (+ traylung platedepth)) traywidth)) (setq cablestartptx (+ baseptx platedepth)) (setq cablestartpty (+ basepty (+ traylung platedepth))) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- (- trayheight (+ traylung platedepth)) platedepth))) ); end of progn ); end of cond case 2 inside rail ladder tray ((= (strcase traytype) "P") (progn (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight platedepth) traywidth)) (setq cablestartptx (+ baseptx platedepth)) (setq cablestartpty (+ basepty platedepth)) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight platedepth))) ); end of progn ); end of cond case 3 perforated tray ((= (strcase traytype) "L") (progn (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* trayheight traywidth)) (setq cablestartptx baseptx) (setq cablestartpty basepty) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty trayheight)) ); end of progn ); end of cond case 4 simple line ((= (strcase traytype) "R") (progn (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* trayheight traywidth)) (setq cablestartptx baseptx) (setq cablestartpty basepty) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty trayheight)) ); end of progn ); end of cond case 5 simple rectangle );end of cond (setq numberyn (getstring "\n Place Number to Cables? (Press Anykey = Yes / N = No) = ")) (setq returnx cablestartptx) (setq maxodin1layer 0) (setq cablemm2 0) (setq cablemm2sum 0) (setq index 0) ;repeat index for numbering (setq index2 0) ;while index for coloring (while (setq cableod (getreal "\n Input Cable O.D. = ")) (setq cableqty (getint "\n Input Cable Q'ty = ")) (setq cablemm2 (* cableod cableod)) (repeat cableqty (if (> cableod maxodin1layer) (setq maxodin1layer cableod) ) (if (> (+ cablestartpty cableod) heightlimit) (princ "\n It's overload") ) (setq cablecenterpt (list (+ cablestartptx (/ cableod 2)) (+ cablestartpty (/ cableod 2)) 0 )) (entmake (list '(0 . "CIRCLE") (cons 8 "0") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 62 (+ index2 1)) )) (if (/= (strcase numberyn) "N") (entmake (list '(0 . "TEXT") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 1 (vl-princ-to-string (+ index 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 cablecenterpt) (cons 100 "AcDbText") (cons 73 2) (cons 62 (+ index2 1)) )) ) (setq cablestartptx (+ cablestartptx cableod)) (setq cablemm2sum (+ cablemm2sum cablemm2)) (if (> (+ cablestartptx cableod) widthlimit) (progn (setq cablestartpty (+ cablestartpty maxodin1layer)) (setq cablestartptx returnx) (setq maxodin1layer 0) ) ) (setq index (+ index 1)) );end of repeat (princ "\n [ Cable Space = ") (princ cablemm2sum) (princ " mm^2 / ") (princ "Tray Space = ") (princ traymm2) (princ " mm^2 ] = Fill Ratio ") (princ (rtos (* (/ cablemm2sum traymm2) 100) 2 2)) (princ " %") (setq index2 (+ index2 1)) );end of while (LM:endundo (LM:acdoc)) (princ) );end of defun (defun ex:EXCTCS ( traytype / *error* traywidth trayheight traylung basept baseptx numberyn cablestartptx cablestartpty widthlimit heightlimit returnx maxodin1layer cablemm2 cablemm2sum index cableqty cableod cablecenterpt traymm2 index2 platedepth railwidth) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (LM:startundo (LM:acdoc)) (defun mysort ( l ) (vl-sort l '(lambda ( a b ) (if (eq (car a) (car b)) (< (caddr a) (caddr b)) (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b))) ) ) ) ) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'GetData "Text")) ;(princ "\n original clipboard text - \n") ;(print txtstring) (setq txtedit1 (LM:str->lst txtstring "\r\n")) ;(princ "\n line break text - \n") ;(print txtedit1) (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)) ;(princ "\n selectedrow - ") ;(print selectedrow) (setq selectedrowlist (LM:str->lst selectedrow "\t")) ;(princ "/ selectedrowlist - ") ;(print selectedrowlist) (setq srllen (length selectedrowlist)) ;(princ "/ srllen - ") ;(princ srllen) (setq subindex 0) (repeat srllen (setq selectedcell (nth subindex selectedrowlist)) (setq sclist '()) (setq sclist (list index selectedcell subindex)) (setq scstack (cons sclist scstack)) (setq subindex (+ subindex 1)) );end of repeat (setq index (+ index 1)) ) ;(princ "\n scstack - ") ;(princ scstack) (setq ss1stacklist (mysort scstack)) ;(princ "\n sorted scstack - ") ;(princ scstack) (setq trayname (cadr (nth 1 ss1stacklist))) (setq traytype (cadr (nth 3 ss1stacklist))) (setq traywidth (atof (vl-princ-to-string (cadr (nth 5 ss1stacklist))))) (setq ss1stacklist (cddddr (cddddr ss1stacklist))) ;(princ ss1stacklist) (setq ss1count (length ss1stacklist)) (setq index3 0) (setq cableinfofromexcel '()) (setq cableinfo1line '()) (repeat (/ ss1count 2) (setq cableodfromexcel (atof (vl-princ-to-string (cadr (nth (+ index3 1) ss1stacklist))))) (setq cablenofromexcel (cadr (nth index3 ss1stacklist))) (setq cableinfo1line (list cableodfromexcel cablenofromexcel)) (setq cableinfofromexcel (cons cableinfo1line cableinfofromexcel)) (setq index3 (+ index3 2)) );end of repeat (setq cableinfofromexcel (vl-sort cableinfofromexcel (function (lambda (x1 x2)(> (car x1) (car x2))) ) ) ) ;(princ cableinfofromexcel) (setq basept (getpoint "\n pick point for tray (bottom center) = ")) (setq baseptx (car basept)) (setq basepty (cadr basept)) (princ (list baseptx basepty)) ;(setq traywidth (getreal "\n Input Tray Width (ex - 150/200/300/450/600/900/1200) = ")) (setq trayheight 150) (setq traylung 15) (setq platedepth 5) (setq railwidth 20) (setq traymm2 0) (cond ((= (strcase traytype) "O") (progn (setq traytypedesc "Ladder Tray - Outside Rail") (setq baseptx (- baseptx (+ (+ (/ traywidth 2) railwidth) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx railwidth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx railwidth) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth (* platedepth 2)))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth (* platedepth 2)))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* (+ railwidth platedepth) 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (+ railwidth platedepth))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight (+ traylung platedepth)) traywidth)) (setq cablestartptx (+ baseptx (+ railwidth platedepth))) (setq cablestartpty (+ basepty (+ traylung platedepth))) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight (+ traylung platedepth)))) ); end of progn ); end of cond case 1 outside rail ladder tray ((= (strcase traytype) "I") (progn (setq traytypedesc "Ladder Tray - Inside Rail") (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ railwidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (- traywidth (- railwidth platedepth))) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty (- trayheight platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty (+ traylung platedepth)))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight (+ traylung platedepth)) traywidth)) (setq cablestartptx (+ baseptx platedepth)) (setq cablestartpty (+ basepty (+ traylung platedepth))) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- (- trayheight (+ traylung platedepth)) platedepth))) ); end of progn ); end of cond case 2 inside rail ladder tray ((= (strcase traytype) "P") (progn (setq traytypedesc "Perforated Tray") (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx platedepth) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty platedepth))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth platedepth)) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ traywidth (* platedepth 2))) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* (- trayheight platedepth) traywidth)) (setq cablestartptx (+ baseptx platedepth)) (setq cablestartpty (+ basepty platedepth)) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty (- trayheight platedepth))) ); end of progn ); end of cond case 3 perforated tray ((= (strcase traytype) "L") (progn (setq traytypedesc "Tray - Simple Line") (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* trayheight traywidth)) (setq cablestartptx baseptx) (setq cablestartpty basepty) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty trayheight)) ); end of progn ); end of cond case 4 simple line ((= (strcase traytype) "R") (progn (setq traytypedesc "Tray - Simple Rectangle") (setq baseptx (- baseptx (+ (/ traywidth 2) platedepth))) (entmake (list '(0 . "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0) (cons 43 0) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty 0))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx traywidth) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty trayheight))) (cons 40 0) (cons 41 0) (cons 42 0) (cons 91 0) ) ); end of entmake (setq traymm2 (* trayheight traywidth)) (setq cablestartptx baseptx) (setq cablestartpty basepty) (setq widthlimit (+ cablestartptx traywidth)) (setq heightlimit (+ cablestartpty trayheight)) ); end of progn ); end of cond case 5 simple rectangle );end of cond (setq numberyn (getstring "\n Place Number to Cables? (Press Anykey = Yes / N = No) = ")) (setq returnx cablestartptx) (setq maxodin1layer 0) (setq cablemm2 0) (setq cablemm2sum 0) (setq index 0) ;repeat index for numbering (setq index2 -1) ;while index for coloring (setq oldcableod 0) (setq cinfolen (length cableinfofromexcel)) (repeat cinfolen (setq cablename (cdr (nth index cableinfofromexcel))) (setq cableod (atof (vl-princ-to-string (car (nth index cableinfofromexcel))))) (if (/= oldcableod cableod) (progn (setq oldcableod cableod) (setq index2 (+ index2 1)) ) );end of if (if (> cableod maxodin1layer) (setq maxodin1layer cableod) ) (if (> (+ cablestartpty cableod) heightlimit) (princ "\n It's overload") ) (setq cablecenterpt (list (+ cablestartptx (/ cableod 2)) (+ cablestartpty (/ cableod 2)) 0 )) (entmake (list '(0 . "CIRCLE") (cons 8 "0") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 62 (+ index2 1)) )) (if (/= (strcase numberyn) "N") (entmake (list '(0 . "TEXT") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 10 cablecenterpt) (cons 40 (/ cableod 2)) (cons 1 (vl-princ-to-string (+ index 1))) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 cablecenterpt) (cons 100 "AcDbText") (cons 73 2) (cons 62 (+ index2 1)) )) ) (setq cablestartptx (+ cablestartptx cableod)) (setq cablemm2 (* cableod cableod)) (setq cablemm2sum (+ cablemm2sum cablemm2)) (if (> (+ cablestartptx cableod) widthlimit) (progn (setq cablestartpty (+ cablestartpty maxodin1layer)) (setq cablestartptx returnx) (setq maxodin1layer 0) ) ) (setq cablefillratio (rtos (* (/ cablemm2sum traymm2) 100) 2 2)) (princ "\n [ Cable Space = ") (princ cablemm2sum) (princ " mm^2 / ") (princ "Tray Space = ") (princ traymm2) (princ " mm^2 ] = Fill Ratio ") (princ cablefillratio) (princ " %") (setq index (+ index 1)) );end of repeat (setq tablept (getpoint "\n Pick Point for Table = ")) (princ tablept) (setq infolst (list "Tray No." trayname "___" "Tray Type" traytypedesc traytype "Tray Width" traywidth "mm" "Cable Area" cablemm2sum "mm^2" "Tray Area" traymm2 "mm^2" "Cable Fill Ratio" cablefillratio "%" " " " " " " "No." "Cable Name" "Cable O.D.")) (sct tablept infolst cableinfofromexcel) (LM:endundo (LM:acdoc)) (princ) );end of defun (defun c:EXCTCSSAMPLE ( / *error* samplist 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 "Tray No." "Tray Type" "Tray Width" "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" "114-OOO-015" "115-PPP-016" "116-QQQ-017" "117-RRR-018" "118-SSS-019" "119-TTT-020" "120-UUU-021" "121-VVV-022" "122-WWW-023" "123-XXX-024") (list "1111-CT-0001" "O" "600" "Cable O.D." "30" "30" "35" "24.5" "18.5" "35" "35" "35" "31.5" "32.5" "31.5" "31.5" "36" "30" "32.5" "22" "27.5" "17.5" "30" "30" "35" "24.5" "18.5" "35") (list "") (list "Tray No." "Tray Type" "Tray Width" "Cable No." "137-LLL-038" "138-MMM-039" "139-NNN-040" "140-OOO-041" "141-PPP-042" "142-QQQ-043" "143-RRR-044" "144-SSS-045" "145-TTT-046" "146-UUU-047" "147-VVV-048" "148-WWW-049" "149-XXX-050" "150-YYY-051" "151-ZZZ-052" "152-AAA-053" "153-BBB-054" "154-CCC-055" "155-DDD-056" "156-EEE-057" "157-FFF-058" "158-GGG-059" "159-HHH-060" "160-III-061" "161-JJJ-062" "162-KKK-063" "163-LLL-064") (list "1234-CT-0002" "I" "900" "Cable O.D." "31" "31" "31" "23" "21" "14.5" "31" "31" "31" "31" "23" "21" "14.5" "31" "31" "31" "31" "23" "21" "14.5" "31" "22.5" "26" "22.5" "26" "13" "18.5") (list "") (list "Tray No." "Tray Type" "Tray Width" "Cable No." "181-DDD-082" "182-EEE-083" "183-FFF-084" "184-GGG-085" "185-HHH-086" "186-III-087" "187-JJJ-088" "188-KKK-089" "189-LLL-090" "190-MMM-091" "191-NNN-092" "192-OOO-093" "193-PPP-094" "194-QQQ-095" "195-RRR-096" "196-SSS-097" "197-TTT-098" "198-UUU-099" "199-VVV-100" "200-WWW-101" "201-XXX-102" "202-YYY-103" "203-ZZZ-104" "203-AAA-104") (list "4567-CT-0003" "P" "200" "Cable O.D." "26" "22.5" "22.5" "35" "22.5" "31" "31" "35" "23" "23" "23" "23" "26" "22.5" "13" "26" "22.5" "22.5" "35" "22.5" "31" "31" "35" "23") )) (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:C30,E3:F33,H3:I30")) (pl:cell-border-fill bordercells '(1 2 3 4) 1 2 23) (setq colorcells (vlax-get-property acsheet 'Range "B3:B6,C6,E3:E6,F6,H3:H6,I6")) (vlax-put-property (vlax-get-property colorcells "Interior") "Colorindex" (vlax-make-variant 37)) (ex:ECSELPUT 1 2 "How to do - Copy B3~C30 then run EXCTCS in CAD") (ex:RELEASEEXCEL) (setvar 'cmdecho 1) (princ) );end of defun (defun ex:ESMAKE ( / ) ;from BIGAL's ah:chkexcel (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 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:ECSELPUT ( r c textstring / c addr c1 c2 c3 rng textstring2 ) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (setq c (+ c 1)) (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-invoke rng 'Select) (setq textstring2 textstring) ;(setq textstring2 (strcat "'" textstring)) (vlax-put-property cell 'item r c textstring2) ) ; by Alaspher https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/make-border-to-an-excel-cell/m-p/1362660/highlight/true#M183776 (defun pl:cell-border-fill (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) ) ) ) ; by BIGAL https://www.cadtutor.net/forum/topic/50401-entmake-table-with-autolisp/?do=findComment&comment=418519 ; example of creating a table (defun sct ( pt infolst lst / colwidth numcolumns numrows objtable rowheight sp vgad vgao ) (vl-load-com) (setq sp (vlax-3d-point pt)) (setq doc (vla-get-activedocument (vlax-get-acad-object) )) (setq vgms (vla-get-modelspace doc)) (setq numrows (+ (length lst) 9)) (setq numcolumns (+ (length (car lst)) 1)) (setq rowheight 40) (setq colwidth 300) (setq tabletxtheight (* rowheight 0.5)) (setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth)) (vla-put-RegenerateTableSuppressed objtable :vlax-True) (vla-setalignment objtable (+ acDataRow acHeaderRow) acMiddleCenter) (vla-settextheight objtable (+ acDataRow acHeaderRow) tabletxtheight) (vla-setcolumnwidth objtable 0 (* (* colwidth 3) 0.3)) (vla-setcolumnwidth objtable 1 (* (* colwidth 3) 0.4)) (vla-setcolumnwidth objtable 2 (* (* colwidth 3) 0.3)) (vla-settext objtable 0 0 "Cable Tray Details") (setq indexinfo 0) (setq indexinfo2 0) (repeat (/ (length infolst) 3) (vla-settext objtable (+ indexinfo2 1) 0 (nth indexinfo infolst)) (vla-settext objtable (+ indexinfo2 1) 1 (nth (+ indexinfo 1) infolst)) (vla-settext objtable (+ indexinfo2 1) 2 (nth (+ indexinfo 2) infolst)) (setq indexinfo (+ indexinfo 3)) (setq indexinfo2 (+ indexinfo2 1)) ) (setq index1 9) (setq index2 0) (repeat numrows (vla-settext objtable index1 index2 (- index1 8)) (vla-settext objtable index1 (+ index2 1) (vl-princ-to-string (cadr (nth (- index1 9) lst)))) (vla-settext objtable index1 (+ index2 2) (vl-princ-to-string (car (nth (- index1 9) lst)))) (setq index1 (+ index1 1)) );end of repeat (vla-deleterows objtable 0 1) (vl-catch-all-apply 'vlax-invoke (list objtable 'MergeCells 0 0 1 2) ) (vl-catch-all-apply 'vlax-invoke (list objtable 'MergeCells 6 6 0 2) ) (vla-put-RegenerateTableSuppressed objtable :vlax-False) (princ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) I update code like this as your notes as i possible. thanks for your help! - removed setvar cmdecho - removed the one used as (*error*) at the end of the function. I saw someone use error msg function at the same time by putting *error* at the end of the routine and I imitated it. - wrapping the user input with and was reflected by dividing the command and changing yes to press any key. and add some minor edit 1. devide command CTCSO - outside rail ladder tray (left of gif) CTCSI - inside rail ladder tray (center of gif) CTCSP - perforated tray (right of gif) 2. use variable - trayheight, traylung, platedepth, railwidth default value : trayheigth = 150, traylung = 15, platedepth = 5, railwidth 20 I changed these from fixed number to variable, but I didn't make it user input to minimize user input. 3. print area ratio was changed to be calculated for each O.D. input. 4. since there is the thickness of the steel plate and width of rail, so changed based on the bottom center. like 3d modeling I am not major in elec., but it seems that most of the trefoil cables are installed in 1 stage in tray. It seems possible to implement it because it is not necessary to think about the y-axis. In the step of inputting cable od, it would be good to add an option to input trefoil and empty gap. This is possible because the routine goes from left to right linearly. It is also worth considering the ability to add a separator and divide the space into two or three. In this case, the complexity will increase, but since it is used a lot in actual work... Thanks for your opinions. Dcl was not applied to this routine because it was considered to input tray quickly or to work with excel. but Most of the time dcl makes the program Complete, (but I haven't mastered it). So your code is very helpful to me! ================================================================================================ edit 1 Added a function to receive input from Excel. This is the use of this feature of BIGAL. thank you. This Lisp uses text from the clipboard, not a range selection. Therefore, it works if you copy the table in the format shown in the figure below from Excel and enter EXCTCS. - tray no. - tray type : O = outside rail ladder tray, I = inside rail ladder tray, P = perforated tray - The number of cables can be added at will. ================================================================================================ edit 2 - add tray shape : simple line, simple rectangle command : CTCSL, CTCSR EXCTCS tray type code "L", "R" - edit typo : platedepth ================================================================================================ edit 3 - add function : make sample excel file for EXCTCS command : EXCTCSSAMPLE Hello exceed, first of all, thank you very much for the very valuable LISP, I am using it a lot for cable tray sizing. I wanted to ask you if you know the reason for the following error when I try to use the EXCTCS command: Thank you very much Quote
Steven P Posted October 30 Posted October 30 You'll need to load the LISP LM:str->lst - it is one of Lee Macs, from his website String to List 1 Quote
juanfran Posted October 31 Posted October 31 12 hours ago, Steven P said: You'll need to load the LISP LM:str->lst - it is one of Lee Macs, from his website String to List Thank you very much, that worked, although the excel table is entered empty: 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.