Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/17/2019 in all areas

  1. ;;;;;;;;;;;;;;;;;;; ;; draw text object (defun Text (pt hgt str color) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 62 color) (cons 1 str))) ) ;;;;;;;;;;;;;;;;;;; (vl-load-com) (defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space) ;; settings, text height, cel height (setq ht 200) (setq htc 380) ;; document, model space, ... (setq acObj (vlax-get-acad-object) acDoc (vla-get-activedocument acObj) space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace)) ) (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht) )) ;; (vla-SetTextHeight tab 1 ht) (vla-SetTextHeight tab 2 ht) (vla-SetTextHeight tab 4 ht) (setq i 0) (repeat (length lst) ;; iterates the rows (vla-setrowHeight tab i htc) (setq row (nth i lst)) (setq j 0) (repeat (length row) ;; iterates the cols in the row (princ "\n") (princ (nth j row)) (vla-SetText tab i j (nth j row) ) (setq j (+ j 1)) ) (setq i (+ i 1)) ) ;; default Autocad expects a totle row. If the first row has more than 1 cel, let's unmerge this row (if (> (length (nth 0 lst)) 1) (vla-unMergeCells tab 0 0 0 0) ) tab ) ;; Offset for each Circle Center (defun c:occ ( / lst ss bp pt i ip radi) ;; select circles (princ "\nSelect circles then press enter: ") (setq ss (ssget (list (cons 0 "CIRCLE")))) (setq bp (getpoint "\nBase point for offset: ")) (setq pt (getpoint "\nInsert point of the table: ")) ;; make the list (setq lst (list (list "Core#" "x" "y") ;; head )) (setq i 0) (repeat (sslength ss) (setq ip (cdr (assoc 10 (entget (ssname ss i))))) ;; circle center (setq radi (cdr (assoc 40 (entget (ssname ss i))))) ;; circle radius (so we know where to put the label) ;; append the list (setq lst (append lst (list (list (+ i 1) ;; 1-based counter, Core# (rtos (car ip) 2 2) ;; 2 decimals, feel free to change this (rtos (cadr ip) 2 2) ) ))) (Text (list (+ (nth 0 ip) radi) (- (nth 1 ip) radi) ) 200 (strcat "Core " (itoa (+ i 1))) 160 ;; blue ) (setq i (+ i 1)) ) (inserttable lst pt) )
    1 point
  2. You're generous .. I wouldn't let them explode my blocks!
    1 point
×
×
  • Create New...