Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/26/2021 in all areas

  1. (defun C:ADDTAB (/ ss lista2d arealist index ename listpoint pointtable objtable) (if (not (setq ss (ssget '((0 . "LWPOLYLINE")(8 . "BOUNDARY"))))) (vl-exit-with-error "") ) (defun lista2d (lst) (if lst (cons (list (car lst) (cadr lst)) (lista2d (cddr lst)) ) ) ) (setq arealist '()) (repeat (setq index (sslength ss)) (setq ename (ssname ss (setq index (1- index)))) (setq listpoint (lista2d (safearray-value (variant-value (vla-get-Coordinates (vlax-ename->vla-object ename)))))) (if (not (setq sstext (ssget "_WP" listpoint '((0 . "MTEXT")(8 . "TABLE TEXT"))))) (ssdel ename ss) (setq arealist (cons (list (vla-get-Textstring (vlax-ename->vla-object (ssname sstext 0))) (vla-get-Area (vlax-ename->vla-object ename))) arealist)) ) ) (setq pointtable (getpoint "\nSelect point insertion table: ") objtable (vla-AddTable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-Point pointtable) (+ 2 (sslength ss)) 2 6 17) index 0 ) (vla-SetText objtable index 0 "AREA TABLE") (vla-SetCellTextHeight objtable index 0 2.40) (vla-SetCellAlignment objtable index 0 acMiddleCenter) (vla-SetText objtable (setq index (1+ index)) 0 "PLOT NO.") (vla-SetCellTextHeight objtable index 0 2.10) (vla-SetCellAlignment objtable index 0 acMiddleCenter) (vla-SetText objtable index 1 "AREA") (vla-SetCellTextHeight objtable index 1 2.10) (vla-SetCellAlignment objtable index 1 acMiddleCenter) (foreach elem arealist (vla-SetText objtable (setq index (1+ index)) 0 (car elem)) (vla-SetCellTextHeight objtable index 0 2.40) (vla-SetCellAlignment objtable index 0 acMiddleCenter) (vla-SetText objtable index 1 (rtos (cadr elem) 2 3)) (vla-SetCellTextHeight objtable index 1 2.10) (vla-SetCellAlignment objtable index 1 acMiddleCenter) ) ) This should be fine. The programme selects the polylines on the BOUNDARY layer, the vertices of the polylines act as a selection for any text inside. If there is no text, the polyline is deleted from the selection set, otherwise a list is created with the text string and the corresponding polyline area. The rest is easy, the table is created with the list data in the AREALIST variable.
    2 points
  2. @confutatis my 2¢ might want to add a closed poly check when selecting the polylines on the boundary layer. you can still return an area on an open polyline and it might not be the full plot area. (if (not (and (setq ss (ssget '((0 . "LWPOLYLINE")(8 . "BOUNDARY")(70 . 1)))))) Also I didn't know this about 3 months ago but WP works great with polylines unless its has arcs. if you use the polyline vertices with WP selection window it will cut corners when their is an arc. Example it wont pick up "test1" text because its outside the white selection window. granted this probably isn't a problem with plots, but caused quite a bit of finger pointing at my work when one of my commands wasn't picking up everything "inside" the polyline. fix here
    1 point
  3. (defun C:ADDROWTAB (/ ss lista2d index ename listpoint objtable) (setvar "NOMUTT" 1) (princ "\nSelect table: ") (setq objtable (ssget "_+.:E:S" '((0 . "ACAD_TABLE")))) (setvar "NOMUTT" 0) (if (not (and (setq ss (ssget '((0 . "LWPOLYLINE")(8 . "BOUNDARY")))))) (vl-exit-with-error "") ) (defun lista2d (lst) (if lst (cons (list (car lst) (cadr lst)) (lista2d (cddr lst)) ) ) ) (setq arealist '()) (repeat (setq index (sslength ss)) (setq ename (ssname ss (setq index (1- index)))) (setq listpoint (lista2d (safearray-value (variant-value (vla-get-Coordinates (vlax-ename->vla-object ename)))))) (if (not (setq sstext (ssget "_WP" listpoint '((0 . "MTEXT")(8 . "TABLE TEXT"))))) (ssdel ename ss) (setq arealist (cons (list (vla-get-Textstring (vlax-ename->vla-object (ssname sstext 0))) (vla-get-Area (vlax-ename->vla-object ename))) arealist)) ) ) (setq objtable (vlax-ename->vla-object (ssname objtable 0))) (setq stringlist '() index 0 ) (while (/= (vla-GetText objtable index 0) "") (setq stringlist (cons (vla-GetText objtable index 0) stringlist)) (setq index (1+ index)) ) (mapcar '(lambda (elem) (if (equal (car elem) (car (member (car elem) stringlist))) (setq arealist (vl-remove elem arealist)))) arealist) (setq index (vla-get-Rows objtable)) (foreach elem arealist (vla-InsertRows objtable index 6 1) (vla-SetText objtable index 0 (car elem)) (vla-SetCellTextHeight objtable index 0 2.40) (vla-SetCellAlignment objtable index 0 acMiddleCenter) (vla-SetText objtable index 1 (rtos (cadr elem) 2 3)) (vla-SetCellTextHeight objtable index 1 2.10) (vla-SetCellAlignment objtable index 1 acMiddleCenter) (setq index (1+ index)) ) (princ) ) Since I have a lot of fun programming in autolisp, I just modified the ADDTAB program with a few changes. The program adds rows to the table, selected additional polylines, without having to redo the table. If an area is already present in the table, it is not inserted again in the table.
    1 point
  4. It has worked for me, I thank you again
    1 point
  5. Try plotting with the latest DWG TrueView. If that doesn't work, something is amiss on your computer and not AutoCAD 2017. You should try to post the file here as well.
    1 point
×
×
  • Create New...