Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/10/2022 in all areas

  1. Give this a try: (defun c:foo (/ s) ;; RJP » 2022-09-09 ;; Generate vertical xlines on polyline vertexes (if (setq s (ssget '((0 . "LWPOLYLINE")))) (progn (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (foreach p (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget e)) (entmakex (list '(0 . "XLINE") '(100 . "AcDbEntity") '(67 . 0) '(8 . "XLINE") '(100 . "AcDbXline") p '(11 0.0 1.0 0.0) ) ) ) ) ;; Make layer not plot and color 128,128,128 (entmod (append (entget (tblobjname "LAYER" "XLINE")) '((290 . 0) (420 . 8421504)))) ) ) (princ) )
    2 points
  2. @Tharwat PERFECT!!!! many thanks, aridzv.
    1 point
  3. Glad that you got it working as expected. Here is another to adjust the alignment as you requested. (defun c:Test (/ lst int sel ent ord qty itm get tag str ins tbl row col) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect attributed blocks : ") (setq int -1 sel (ssget '((0 . "INSERT") (66 . 1)))) (while (setq int (1+ int) ent (ssname sel int)) (setq ord nil qty nil itm nil) (while (/= (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND" ) (setq tag (cdr (assoc 2 get)) str (cdr (assoc 1 get)) ) (vl-some (function (lambda (j k) (and (= tag j) (set k str)))) '("ORDER" "QUANTITY" "ITEM_DESCRIPTION") '(ord qty itm) ) ) (and ord itm qty (or (vl-some '(lambda (u) (and (eq (car u) ord) (eq (cadr u) itm) (setq lst (subst (list ord itm (vl-princ-to-string (+ (read qty) (read (caddr u))) ) ) u lst ) ) ) ) lst ) (setq lst (cons (list ord itm qty) lst)) ) ) lst ) (setq ins (getpoint "\nSpecify table insertion point : ")) (setq tbl (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point ins) (1+ (length lst)) 3 145 46 ) row 2 col -1 ) (progn (mapcar '(lambda (w) (vla-setcolumnwidth tbl (setq col (1+ col)) w)) '(145 845 88) ) (setq col -1) (vla-put-RegenerateTableSuppressed tbl :vlax-true) (vla-put-Vertcellmargin tbl 10.55) (vla-put-Horzcellmargin tbl 10.55) (vla-unmergecells tbl 0 0 0 2) (mapcar '(lambda (s c) (Set:text:contents_ tbl 0 c s acMiddleLeft) (vla-setrowheight tbl 0 45) ) '("ITEM No." "ITEM DESCRIPTION" "QTY") '(0 1 2) ) (setq row 1 col -1 ) (foreach itm (vl-sort lst (function (lambda (j k) (< (atoi (car j)) (atoi (car k)))) ) ) (mapcar '(lambda (s c a) (Set:text:contents_ tbl row c s (eval a)) ) itm '(0 1 2) '(acMiddleCenter acMiddleLeft acMiddleCenter) ) (vla-setrowheight tbl row 1.0) (setq row (1+ row) col -1 ) ) (vla-put-RegenerateTableSuppressed tbl :vlax-false) ) ) (princ) ) (vl-load-com) (defun Set:text:contents_ (o_ r_ c_ v_ a_) (vla-settext o_ r_ c_ (strcat "{\\fCalibri|b0|i0|c0|p34;" v_ "}")) (vla-setcelltextheight o_ r_ c_ 18.5) (vla-setcellalignment o_ r_ c_ a_) )
    1 point
  4. Give you a try and let me know. (defun c:Test (/ lst int sel ent ord qty itm get tag str ins tbl row col) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect attributed blocks : ") (setq int -1 sel (ssget '((0 . "INSERT") (66 . 1)))) (while (setq int (1+ int) ent (ssname sel int)) (setq ord nil qty nil itm nil) (while (/= (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND") (setq tag (cdr (assoc 2 get)) str (cdr (assoc 1 get)) ) (vl-some (function (lambda (j k) (and (= tag j) (set k str)))) '("ORDER" "QUANTITY" "ITEM_DESCRIPTION") '(ord qty itm) ) ) (and ord itm qty (or (vl-some '(lambda (u) (and (eq (car u) ord) (eq (cadr u) itm) (setq lst (subst (list ord itm (vl-princ-to-string (+ (read qty) (read (caddr u))) ) ) u lst ) ) ) ) lst ) (setq lst (cons (list ord itm qty) lst)) ) ) lst ) (setq ins (getpoint "\nSpecify table insertion point : ")) (setq tbl (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point ins) (1+ (length lst)) 3 145 46 ) row 2 col -1 ) (progn (mapcar '(lambda (w) (vla-setcolumnwidth tbl (setq col (1+ col)) w)) '(145 845 88) ) (setq col -1) (vla-put-RegenerateTableSuppressed tbl :vlax-true) (vla-put-Vertcellmargin tbl 10.55) (vla-put-Horzcellmargin tbl 10.55) (vla-unmergecells tbl 0 0 0 2) (mapcar '(lambda (s c) (Set:text:contents_ tbl 0 c s) (vla-setrowheight tbl 0 45) ) '("ITEM No." "ITEM DESCRIPTION" "QTY") '(0 1 2) ) (setq row 1 col -1 ) (foreach itm (vl-sort lst (function (lambda (j k) (< (atoi (car j)) (atoi (car k)))) ) ) (mapcar '(lambda (s c) (Set:text:contents_ tbl row c s) ) itm '(0 1 2) ) (vla-setrowheight tbl row 1.0) (setq row (1+ row) col -1 ) ) (vla-put-RegenerateTableSuppressed tbl :vlax-false) ) ) (princ) ) (vl-load-com) (defun Set:text:contents_ (o_ r_ c_ v_) (vla-settext o_ r_ c_ (strcat "{\\fCalibri|b0|i0|c0|p34;" v_ "}")) (vla-setcelltextheight o_ r_ c_ 18.5) (vla-setcellalignment o_ r_ c_ acMiddleLeft) )
    1 point
  5. If your using layouts then can draw grids on Viewports. Yes code by me.
    1 point
  6. Any idea why this isn't working anymore in AutoCAD 2019?
    1 point
×
×
  • Create New...