API tools faq
paste
Advertisement
mhemay

steel

mhemay
May 6th, 2023 (edited)
163
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
CAD Lisp 7.48 KB | None | 0 0
raw download clone embed print report
  1. (defun C:stel (/ tbl)
  2.   (setq error 0)
  3.   (setq la (getvar "CLAYER"))
  4.   (command "-layer" "m" "check" "c" "140" "" "")
  5.   (command "-osnap" "off")
  6.   (setq q0 (ssget "ALL" '((8 . "steels") (0 . "text"))))
  7.   (setq no (sslength q0))
  8.   (setq n 0)
  9.   (setq total-length 0.0)
  10.   (setq total-weight 0.0)
  11.   (setq table-data '())
  12.   (while (< n no)
  13.     (setq qq (ssname q0 n))
  14.     (setq n (+ n 1))
  15.     (setq q1 (entget qq))
  16.     (setq q2 (assoc 1 q1))
  17.     (setq q3 (cdr q2))
  18.     (setq f (atof (substr q3 1 2)))
  19.     (setq p (cdr (assoc 10 q1)))
  20.     (setq hi (cdr (assoc 40 q1)))
  21.     (setq n0 0)
  22.     (while (< n0 no)
  23.       (setq qq0 (ssname q0 n0))
  24.       (setq n0 (+ n0 1))
  25.       (setq q10 (entget qq0))
  26.       (setq q20 (assoc 1 q10))
  27.       (setq q30 (cdr q20))
  28.       (setq f0 (atof (substr q30 1 2)))
  29.       (setq p0 (cdr (assoc 10 q10)))
  30.       (if (and (= f0 f) (/= q3 q30))
  31.     (progn
  32.       (command "line" p p0 "")
  33.       (setq pp (list (- (min (car p) (car p0)) (* 4 hi))
  34.              (- (min (cadr p) (cadr p0)) (* 4 hi))))
  35.       (setq pp0 (list (+ (max (car p) (car p0)) (* 4 hi))
  36.               (+ (max (cadr p) (cadr p0)) (* 4 hi))))
  37.       (COMMAND "ZOOM" PP PP0)
  38.       (setq opp (rtos f 2 0))
  39.       (setq dia (getreal (strcat "Enter the diameter of rebar (" opp "): ")))
  40.       (setq num (getint (strcat "Enter the number of rebars at position " opp ": ")))
  41.       (setq length (vlax-curve-getDistAtParam (vlax-ename->vla-object qq) (vlax-curve-getEndParam (vlax-ename->vla-object qq))))
  42.       (setq total-length (+ total-length length))
  43.       (setq unit-weight (/ (assoc dia '((10 . 0.617) (12 . 0.888) (14 . 1.21) (16 . 1.58) (18 . 2.00) (20 . 2.47) (22 . 2.98) (25 . 3.85) (28 . 4.83) (30 . 5.55) (32 . 6.31))) 1))
  44.       (setq weight (* unit-weight length num))
  45.       (setq total-weight (+ total-weight weight))
  46.       (setq table-data (append table-data `((,opp ,dia ,num "6@" ,length "L=12" ,weight)))))
  47.     )
  48.   )
  49.     (setq table-data (append table-data `(("Total Length (m)" "" "" "" ,total-length "" "" "")))))
  50.     (setq footer-row1 `(("Total Length (m)" "" "" "" ,total-length "" "" "")))
  51.     (setq footer-row2 `(("Unit Weight (kg/m)" "" "" "" ,unit-weight "" "" "")))
  52.     (setq footer-row3 `(("Total Weight (kg)" "" "" "" ,total-weight "" "" "")))
  53.     (setq footer-row4 `(("Total Cost" "" "" "" ,total-cost "" "" "")))
  54.    
  55.  
  56.     ;; add footer rows
  57.     (setq unit-weight (/ (assoc dia '((10 . 0.617) (12 . 0.888) (14 . 1.21) (16 . 1.58) (18 . 2.00) (20 . 2.47) (22 . 2.98) (25 . 3.85) (28 . 4.83) (30 . 5.55) (32 . 6.31))) 1.0))
  58.     (setq total-weight (* unit-weight total-length))
  59.     (setq total-weight-str (rtos total-weight 2 2))
  60.     (setq total-weight-with-unit (strcat total-weight-str " kg"))
  61.     (setq total-weight-with-comma (strreplace total-weight-with-unit "." ","))
  62.     (setq total-weight-with-space (strcat " " total-weight-with-comma))
  63.     (setq table-data (append table-data `(("Unit Weight (kg/m)" "" "" ,unit-weight "" "" ""))))
  64.     (setq table-data (append table-data `(("Total Weight (kg)" "" "" "" ,total-weight-with-space "" ""))))
  65.     (setq table-data (append table-data `(("Total (kg)" "" "" "" ,total-weight-with-space "" "" ""))))
  66.     ;; create table
  67.     (setq table (vla-addtable ms (vlax-3d-point 0 0 0) (length table-data) (length (car table-data)) 1))
  68.     ;; set table style
  69.     (vla-put-CellStyle table (vla-get-CellStyle ms "Standard"))
  70.     ;; set column widths
  71.     (vla-put-ColumnWidth table 0 (* 2.5 col-width))
  72.     (vla-put-ColumnWidth table 1 (* 1.75 col-width))
  73.     (vla-put-ColumnWidth table 2 (* 2 col-width))
  74.     (vla-put-ColumnWidth table 3 (* 2 col-width))
  75.     (vla-put-ColumnWidth table 4 (* 2.5 col-width))
  76.     (vla-put-ColumnWidth table 5 (* 2 col-width))
  77.     (vla-put-ColumnWidth table 6 (* 2.75 col-width))
  78.     ;; set cell text and alignment
  79.     (vlax-for c table
  80.       (vla-put-Alignment c acMiddleCenter)
  81.     )
  82.     (vlax-for r table
  83.       (vlax-for c r
  84.         (vla-put-Text c (nth (1- (vlax-curve-getEndParam (vla-get-ObjectID selected-curve)))) table)
  85.         (vla-put-Alignment c acMiddleCenter)
  86.       )
  87.     )
  88.     ;; merge header cells
  89.     (vla-MergeCells table (vlax-3d-point 0 0 0) (vlax-3d-point 1 0 0))
  90.     (vla-MergeCells table (vlax-3d-point 0 1 0) (vlax-3d-point 0 3 0))
  91.     (vla-MergeCells table (vlax-3d-point 0 4 0) (vlax-3d-point 0 6 0))
  92.     ;; set header text and alignment
  93.     (vla-put-Text (vla-get-Cell table 0 0) "Steel Schedule")
  94.     (vla-put-Alignment (vla-get-Cell table 0 0) acMiddleCenter)
  95.     (vla-put-Text (vla-get-Cell table 0 1) header-text)
  96.     (vla-put-Alignment (vla-get-Cell table 0 1) acMiddleCenter)
  97.  
  98.     ;; set footer text and alignment
  99.     (vla-put-Text (vla-get-Cell table 4 0) "Total Length (m)")
  100.     (vla-put-Alignment (vla-get-Cell table 4 0) acMiddleLeft)
  101.     (vla-put-Text (vla-get-Cell table 4 1) "")
  102.     (vla-put-Alignment (vla-get-Cell table 4 1) acMiddleLeft)
  103.     (vla-put-Text (vla-get-Cell table 4 2) "")
  104.     (vla-put-Alignment (vla-get-Cell table 4 2) acMiddleLeft)
  105.     (vla-put-Text (vla-get-Cell table 4 3) "")
  106.     (vla-put-Alignment (vla-get-Cell table 4 3) acMiddleLeft)
  107.     (vla-put-Text (vla-get-Cell table 4 4) (rtos total-length 2 2))
  108.     (vla-put-Alignment (vla-get-Cell table 4 4) acMiddleRight)
  109.     (vla-put-Text (vla-get-Cell table 4 5) "")
  110.     (vla-put-Alignment (vla-get-Cell table 4 5) acMiddleLeft)
  111.  
  112.     (vla-put-Text (vla-get-Cell table 3 0) "Unit Weight (kg/m)")
  113.     (vla-put-Alignment (vla-get-Cell table 3 0) acMiddleLeft)
  114.     (vla-put-Text (vla-get-Cell table 3 1) "")
  115.     (vla-put-Alignment (vla-get-Cell table 3 1) acMiddleLeft)
  116.     (vla-put-Text (vla-get-Cell table 3 2) "")
  117.     (vla-put-Alignment (vla-get-Cell table 3 2) acMiddleLeft)
  118.     (vla-put-Text (vla-get-Cell table 3 3) "")
  119.     (vla-put-Alignment (vla-get-Cell table 3 3) acMiddleLeft)
  120.     (vla-put-Text (vla-get-Cell table 3 4) (rtos unit-weight 2 3))
  121.     (vla-put-Alignment (vla-get-Cell table 3 4) acMiddleRight)
  122.     (vla-put-Text (vla-get-Cell table 3 5) "")
  123.     (vla-put-Alignment (vla-get-Cell table 3 5) acMiddleLeft)
  124.  
  125.     (vla-put-Text (vla-get-Cell table 2 0) "Total Weight (kg)")
  126.     (vla-put-Alignment (vla-get-Cell table 2 0) acMiddleLeft)
  127.     (vla-put-Text (vla-get-Cell table 2 1) "")
  128.     (vla-put-Alignment (vla-get-Cell table 2 1) acMiddleLeft)
  129.     (vla-put-Text (vla-get-Cell table 2 2) "")
  130.     (vla-put-Alignment (vla-get-Cell table 2 2) acMiddleLeft)
  131.     (vla-put-Text (vla-get-Cell table 2 3) "")
  132.     (vla-put-Alignment (vla-get-Cell table 2 3) acMiddleLeft)
  133.     (vla-put-Text (vla-get-Cell table 2 4) (rtos total-weight 2 2))
  134.     ;; set footer text and alignment
  135.     (vla-put-Alignment (vla-get-Cell table 2 4) acMiddleRight)
  136.  
  137.     (vla-put-Text (vla-get-Cell table 3 3) "Total (kg)")
  138.     (vla-put-Alignment (vla-get-Cell table 3 3) acMiddleLeft)
  139.     (vla-put-Text (vla-get-Cell table 3 4) (rtos (+ total-weight total-space-weight) 2 2))
  140.     (vla-put-Alignment (vla-get-Cell table 3 4) acMiddleRight)
  141.  
  142.     ;; set table properties
  143.     (vla-put-Height table 250.0)
  144.     (vla-put-Width table 300.0)
  145.     (vla-put-TextHeight table 2.5)
  146.     (vla-put-Alignment table acMiddleCenter)
  147.  
  148.     ;; fit table to contents
  149.     (vla-put-ColumnWidth table 0 acHeaderAndDataCells acBestFit)
  150.     (vla-put-ColumnWidth table 1 acHeaderAndDataCells acBestFit)
  151.     (vla-put-ColumnWidth table 2 acHeaderAndDataCells acBestFit)
  152.     (vla-put-ColumnWidth table 3 acHeaderAndDataCells acBestFit)
  153.     (vla-put-ColumnWidth table 4 acHeaderAndDataCells acBestFit)
  154.     (vla-put-ColumnWidth table 5 acHeaderAndDataCells acBestFit)
  155.     (vla-put-ColumnWidth table 6 acHeaderAndDataCells acBestFit)
  156.  
  157.     ;; insert table into drawing
  158.     (setq insPt (vlax-3d-point (list 0.0 0.0 0.0)))
  159.     (setq tableObj (vla-InsertBlockSpace table insPt 1.0 1.0 1.0 0.0))
  160.     (vla-put-Layer tableObj la)
  161.  
  162.     ;; cleanup
  163.     (vla-EndUndoMark doc)
  164.     (vla-Regen doc acAllViewports)
  165.     (alert "Table created successfully!")
  166. )
  167.  
  168.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!