Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/23/2024 in all areas

  1. Yeah, sure. With NENTSEL you van select nested items: for example items inside a XREF or Block. Here's a function that turns off layers of selected nested items. Command LOFF, for Layers OFF Command NLAYISO for the question you asked for ;; @see https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/turning-off-layers-in-autolisp/td-p/6339611 (DEFUN LAYER_OFF (mylayer on_off / Layoff ) ;;(setq Layoff(getstring "\Should the Layer C165-C345-EBENE turned off? (j/n): ")) (setq Layoff "Y") (if (or (= Layoff "j") (= Layoff "J") (= Layoff "y") (= Layoff "Y")) (if (/= (tblsearch "layer" mylayer) nil) ;;(command "_layer" "_off" mylayer "") (command "_layer" on_off mylayer "") ;;(princ mylayer) );IF );IF );DEFUN LAYER_OFF ;; Turns off layers of NENTSEL selection, of the layer of nested objects (defun c:loff ( / sel obj lay lst) (while (setq sel (nentsel "Select object: ")) (setq obj (car sel)) (setq lay (cdr (assoc 8 (entget obj)))) (LAYER_OFF lay "_off") ) ) ;; nLayiso for Nested Layiso (defun c:nLayiso ( / blk sel obj lay lst) (setq lst (list)) (while (setq sel (nentsel "\nSelect object: ")) (setq obj (car sel)) (setq lay (cdr (assoc 8 (entget obj)))) (setq lst (append lst (list lay))) (princ lay) ) ;; loop over all layers in the drawing (vlax-for lyr (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (setq lay (vla-get-name lyr)) ;; exclude current layer (if (/= lay (getvar "CLAYER")) ;; IF layer is in lst then turn on, else turn off (if (member lay lst) (LAYER_OFF lay "_on") (LAYER_OFF lay "_off") ) ) ) ) Happy with this?
    1 point
  2. A ssget with correct block filter should work. (setq ss (ssget (list (cons 0 "INSERT")(cons 2 "DIN934-A#M##*")))) or a full filter (setq ss (ssget (list (cons 0 "INSERT")(cons 2 "DIN934-A#M##ED,DIN934-A#M##SD"))))
    1 point
  3. ; 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
    1 point
  4. 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
    1 point
  5. Hi All, I thought it would be beneficial to everyone if I posted a LISP I wrote a while ago that saves time when drawing piping equipment. The LISP will draw various sizes of: Pipe (plan/elevation) Flange (plan/elevation) Elbow (plan/elevation) Tee (plan/elevation) All are drawn using measurements taken from the American National Standards Institute (ANSI). I hope it is of some use. PIPE & FLANGE DRAUGHTSMAN.zip
    1 point
  6. Hi Guys, I found a minor error in the code of my first post. I have now updated this and uploaded the updated file. Sorry for any inconvenience.
    1 point
×
×
  • Create New...