Leaderboard

This is taking the above a little further, but is not as finished as I might want. The user can alter the direction before or after selecting the entities rather than selecting the direction and then the entities. I reckon if you are using grread in something similar you are wanting quite a complex solution, most users are happy with 'select an option and enter' to continue. A bit of work to do another time so show the rubber bands for the stretches and to add in object snaps, but I am just adding this in here as an example - I might get more chance to look at this another day. (defun c:GRStretch ( / mod MyDist MyEnt MySS pt1 pt2 pt3 pt4 endloop acount) (setq endloop "No") (setq mod "X") (princ (strcat "Press \"X\" or \"Y\" [" mod "], select entities to stretch, or [ENTER] to exit: ")) (while (and (setq g (grread t 14 2)) (= endloop "No") ) (cond ((= (car g) 2) ;;Set mode - text entry (if (or (= 88 (cadr g))(= 120 (cadr g))) (setq mod "X")) ; x, X (if (or (= 89 (cadr g))(= 121 (cadr g))) (setq mod "Y")) ; y, Y (if (or (= 13 (cadr g))(= 32 (cadr g))) (setq endloop "Yes")) ; end loop marker ;;NUMBER ENTRY (if (and (< 48 (cadr g)) (< (cadr g) 57)) (progn (princ "\n")(princ (chr (cadr g))) (setq MyDist (atof (strcat (chr (cadr g)) (rtos (getreal)))))(princ "\n")(princ MyDist) ) ) ;;END NUMBER ENTRY (princ (strcat "\nPress \"X\" or \"Y\" [" mod "], select entities to stretch, or [ENTER] to exit: ")) ; change of mod ) ; end text entry cond ((= (car g) 3) ;;Set click (cond ; set / reset points ((= pt1 nil)(setq pt1 (cadr g))) ((= pt2 nil)(setq pt2 (cadr g))) ((= pt3 nil)(setq pt3 (cadr g))) ((= pt4 nil)(setq pt4 (cadr g))) ( T (setq pt1 nil)(setq pt2 nil)(setq pt3 nil)(setq pt4 nil)) ; reset points ) (if (setq MyEnt (car (nentselp pt1)) ) ; if single entity selected (progn (redraw MyEnt 3) (setq pt2 pt1) (princ (strcat "\nSingle Entity Selected.\nSpecify base point (or X, Y) [" mod "].")) ) ; end progn ) ; end if (if (and pt1 pt2 (not MyEnt)) (progn (if (< (car Pt1)(car Pt2)) ; L->R Selection (setq MySS (ssget "_W" Pt1 Pt2 )) ; Window selection (setq MySS (ssget "_C" Pt1 Pt2 )) ; crossing selection ) (redraw) (if MySS (progn (setq acount 0) (while (< acount (sslength MySS)) (redraw (ssname MySS acount) 3) (setq acount (+ acount 1)) ) ; end while MySS (princ (strcat "\nEntities Selected.\nSpecify base point (or X, Y) [" mod "].")) ) ; end progn (progn (setq pt1 nil)(setq pt2 nil)(setq pt3 nil)(setq pt4 nil) ) ) ; end if MySS ) ; end progn ) ; end if pt1, pt2, not MyEnt ) ; end click entry cond ((and pt1 (not pt2) (= (car g) 5) (not MyEnt) ) ; Draw selection rectangle (setq p3 (cadr g)) (setq p2 (list (car pt1) (cadr p3))) (setq p4 (list (car p3) (cadr pt1))) (redraw) (grvecs (list -256 pt1 p2 p2 p3 p3 p4 p4 pt1)) ) ) ; end conds ;;Single entity stretch ; (if (and pt2 MyEnt) (if (and pt3 MyEnt) (progn (princ "\nSpecify second point") (if (= mod "X") ; X or Y axis ; (command "_.stretch" MyEnt "" (mapcar '* '(1 0 0) pt2) (mapcar '* '(1 0 0) (setq pt3 (getpoint)))) ; (command "_.stretch" MyEnt "" (mapcar '* '(0 1 0) pt2) (mapcar '* '(0 1 0) (setq pt3 (getpoint)))) (command "_.stretch" MyEnt "" (mapcar '* '(1 0 0) pt3) (mapcar '* '(1 0 0) (setq pt4 (getpoint)))) (command "_.stretch" MyEnt "" (mapcar '* '(0 1 0) pt3) (mapcar '* '(0 1 0) (setq pt4 (getpoint)))) ) (redraw MyEnt 4) (setq pt1 nil)(setq pt2 nil)(setq pt3 nil)(setq pt4 nil) ; reset points (setq MyEnt nil)(setq MySS nil) ; reset entity selection (princ (strcat "Press \"X\" or \"Y\" [" mod "], select entities to stretch, or [ENTER] to exit: ")) ) ; end progn ) ; end if ;;Selection set stretch (if (and pt3 MySS) (progn (princ "\nSpecify second point") (if (= mod "X") ; X or Y axis (command "_.stretch" MySS "" (mapcar '* '(1 0 0) pt3) (mapcar '* '(1 0 0) (setq pt4 (getpoint)))) (command "_.stretch" MySS "" (mapcar '* '(0 1 0) pt3) (mapcar '* '(0 1 0) (setq pt4 (getpoint)))) ) (setq acount 0) ; remove highlights (while (< acount (sslength MySS)) (redraw (ssname MySS acount) 4) (setq acount (+ acount 1)) ) ; end while MySS (setq pt1 nil)(setq pt2 nil)(setq pt3 nil)(setq pt4 nil) ; reset points (setq MyEnt nil)(setq MySS nil) ; reset entity selection ) ; end progn ) ; end if ) ; end while grread (redraw) (command "regen") (princ "Ended OK")(princ) ) -EDIT- Added a quick number entry function to specify distance later

Hey guys, just recently enrolled in an architecture autocad course and due to unfortunate circumstances I had to miss out on much of the first month and I am BEHIND! I need to do some floor plans of Rem Koolhaas' Bordeaux maison. He gave us 3 PDF files and we have to reconstruct them in AutoCAD. He recommended starting with the second floor which I have started here. Now I am completely lost. I have no idea how to make this drawing accurate. I have no idea how to read my floor plan printed on paper using an architectural scale. I THINK we are in metric units and it says it is 1:200 scale on the corner of the pdf files. I just have no idea where to start. I used a school computer in which my professor tweaked the settings to start it up and now I have to use a home computer and I don't even know how to set it up with the same settings he used (does it matter; can I go back to tweak it???) I was able to put this outline together from entering the dimensions on the side of my floor plan sheet but now I am stumped. For example, I don't know what distance to measure the offset borders. Any help would be appreciated, I am not asking for anyone to do my work because I want to learn. But I am stressed out because I need to complete at least the whole second floor by this weekend.

(setq lst nil) (if (and (setq ent (car (entsel))) (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")) (progn (setq pa (if (vlax-curve-IsClosed ent) (vlax-curve-getEndParam ent) (+ (vlax-curve-getEndParam ent) 1))) (while (setq pt (vlax-curve-getPointAtParam ent (setq pa (- pa 1)))) (setq lst (cons pt lst)) ) ) ) (vl-cmdf "_AeccDeleteSurfaceLine" "F" lst) The first part selects the polyline and extracts vertex coordinates to a list I need to delete lines from the surface using the command "_AeccDeleteSurfaceLine" with parameter "F" fence Test.dwg

Thanks. Strange, I am still on 2022 though about time to update. Sounds like it is running through the code OK but the code isn't doing what it should. I'm not happy with the code yet, aiming next time I look at it to pick all points before the stretch which might fix that, or it might add a whole world of problems. Pick all points before stretching then OP can switch X to Y at any point in the routine. Got Lee Macs grsnap to add into it too - snaps would be handy (grread doesn't do snaps). Next change is to specify a distance rather than mouse clicks

@Steven P Nice coding. I am currently studying it and good move to use point capture to create the selection window ahead of time. However - It doesn't seem to work for me in my AutoCAD 2025. No sure why yet. The prompts all work fine, but it's not switching the pickbox to the to the base point selection for me, even though the prompt is saying so. When I try selecting it with the pickbox cursor, it seems to select a point, but then does nothing when I select the 2nd point, except exit out. However, if the OP is happy and it's working for him - then great!

ok it makes more sense now

Thanks @Steven P, looks good so far. To give insight into my reasoning for this, is to lock either the X or Y axis to allow snapping to an endpoint only. I mocked up an example but I trust you that I use this in my day-to-day work.

Why don't you have a go always a good time to learn. At the heart of the code, is the change object property. (vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color)) (vl-catch-all-apply 'vla-put-TextColor (list Obj Color)) (vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color)) So if you look at the properties of an object using DUMPIT.lsp you should be able to work out correct Vla-put-property. DumpIt.LSP

Post a dwg. Should be able to use Hatchb.lsp to make a boundary and get the points of the boundary, if its more than 4 vertices or small sides are different lengths then it's not really a pline shape.

That's a lot of (good) code Steven but still trying to wrap my mind around OP's request and if its academic or has any practical use.

(defun c:t1 ( / al ss ) (setq al (vla-get-activelayout (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (setq ss (ssget "_X" (list '(0 . "LWPOLYLINE")))) (vlax-for o (setq s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) (setq h (vla-addhatch (vlax-get al 'block) acHatchPatternTypePredefined "SOLID" :vlax-true)) (vlax-invoke h 'AppendOuterLoop (list o))(vlax-invoke h 'Evaluate) ) ) (princ) ) (defun c:t2 ( / al ss) (setq al (vla-get-activelayout (vla-get-ActiveDocument (vlax-get-acad-object)))) (princ "\nSelect objects to apply solid hatch to : ") (if (setq ss (ssget (list '(0 . "LWPOLYLINE")))) (vlax-for o (setq s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) (setq h (vla-addhatch (vlax-get al 'block) acHatchPatternTypePredefined "SOLID" :vlax-true)) (vlax-invoke h 'AppendOuterLoop (list o))(vlax-invoke h 'Evaluate) ) ) (princ) )

Since AutoLISP lists are stored as singly-linked lists in memory (whereby each element is a pair consisting of a value (car) and a pointer to the next pair (cdr), with the last pair containing a null pointer), using cons to push an item onto a list is a very efficient operation, as a new cons pair can simply point to the previous head of the list. Whereas, to append an element to the end of the list, the interpreter must traverse the entire linked list and point the last element to the newly appended element. As such, the performance of cons will not be impacted by the list length, whereas the performance of append will worsen by a factor of the list length.

; 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

Ok guys, thank you for the support thus far. I've attached some files that you can hopefully check out with more accuracy. In my attachments I have my progress, the PDF file I am working off of, and I also converted the PDF to a DWG (not sure if this is cheating, but the conversion seems clean but I am unsure if it is accurate. My question is will this expedite my work? Of course I want to learn and not cheat, and will use only as reference.) Bordeaux-A2.1-KF-130312.dwg a2.2 100223.pdf a2.2-100223.dwg

I respect what you're saying and I feel really embarrassed. But I won't drop the class and will continue to try to figure this out. I will upload the dwg file as soon as I get home.

As a professor I would recommend that you drop the class and take it again when you can. What would it say about my efforts of a professor if I couldn't progress the class in that time well beyond what anyone could catch up on their own? Why would they even need me or a class? I would not expect anyone missing significant time to be successful. Not that it is any fault of their own, but simply because a significant amount of valuable instruction was missed. Enough with the reality check. OK, if you are determined to give this a go - do as much as you can (looks like you were able to at least get a start) and then attach the dwg file (rather than images) here for suggestions on next steps.

I was referring to the template that you use when you start a new drawing. The default template in AutoCAD will utilize imperial units. It is named acad.dwt while the template that should be used for metric drawings is named acadiso.dwt. If you type -DWGUNITS at the command line and then press the Enter key AutoCAD will return the following: Command: -DWGunits Loading AEC Base... Loading AEC Base Extended... Loading AEC Core... Drawing units: 1. Inches 2. Feet 3. Millimeters 4. Centimeters 5. Decimeters 6. Meters Unit for length : See that "3"? It means 1 unit = 1mm. So now, going back to what I said earlier, if a dimension for the width of a room is shown as being 245mm then, in model space, you draw it 245 units long. You do NOT scale it. Scale is of no importance until we switch to our layout and create a viewport to see the floor plan we drew back in model space. Should the PDF of the floor plan have the rooms/building dimensioned in meters then you will have to either do the math (covert meters to millimeters) or change to option "6" (meters). Unfortunately I will be away from my computer the remainder of the night. There are other regular forum members who will certainly assist you in my absence. In the morning (I am located on the east coast of the United States) I will look for and check the progress of this thread.

I am unsure which template I have to use. I think it is in metric because there is a scale on the pdf file that shows 0-2m-4m. Is there anyway that I can get you the PDF file for you to take a closer look at? or if there is any good websites to upload it so you can see it better? EDIT: I've tried to upload them on imgur, if you click on the image it expands a little. Maybe this helps out (Notice on the second image, the scale is shown on the bottom right hand corner.) http://imgur.com/a/tWHvo