Polyline to block with attributes

[BlackDev1l]

(defun C:P2B (/ ss base n blk pl); = Polylines [to] Blocks
  (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
    (progn ; then
    (setq base 0)
    (while (tblsearch "block" (strcat "" (itoa (1+ base))))
      (setq base (1+ base))
    ); while
    (repeat (setq n (sslength ss))
      (command
        "_.block" (setq blk (strcat "" (itoa (+ base n)))); increment Block name
          "_none" (vlax-curve-getStartPoint (setq pl (ssname ss (setq n (1- n)))))
          pl ""
        "_.insert" blk "_none" "@" "" "" ""
      ); command
    ); repeat
    ); progn
  ); if
); defun

This code works correctly. Please help me how to add an attribute to the created block with area of the selected polyline.

[marko_ribar]

Here you are :

 

(defun C:P2B (/ *error* atd ss base n pl ar ll ur mp att blk); = Polylines [to] Blocks

  (vl-load-com)

  (defun *error* (m)
    (if atd
      (setvar 'attdia atd)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (setq atd (getvar 'attdia))
  (setvar 'attdia 0)
  (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))))
    (progn ; then
      (setq base 0)
      (while (tblsearch "block" (strcat "" (itoa (1+ base))))
        (setq base (1+ base))
      ); while
      (repeat (setq n (sslength ss))
        (setq pl (ssname ss (setq n (1- n))))
        (setq ar (vlax-curve-getArea pl))
        (vla-getBoundingBox (vlax-ename->vla-object pl) 'll 'ur)
        (mapcar 'set '(ll ur) (mapcar 'safearray-value (list ll ur)))
        (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) ll ur))
        (command "_.attdef" "" (itoa (+ base n)) "" "" "_none" mp (getvar 'textsize) "")
        (setq att (entlast))
        (command
          "_.block" (setq blk (itoa (+ base n))); increment Block name
            "_none" (trans (vlax-curve-getStartPoint pl) 0 1)
            pl att ""
          "_.insert" blk "_none" "@" "" "" "" ar
        ); command
      ); repeat
    ); progn
  ); if
  (*error* nil)
); defun

 

HTH.

M.R.

Edited May 31, 2023 by marko_ribar

[BlackDev1l]

11 hours ago, marko_ribar said:

(defun C:P2B (/ *error* atd ss base n pl ar ll ur mp att blk); = Polylines [to] Blocks

  (vl-load-com)

  (defun *error* (m)
    (if atd
      (setvar 'attdia atd)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (setq atd (getvar 'attdia))
  (setvar 'attdia 0)
  (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))))
    (progn ; then
      (setq base 0)
      (while (tblsearch "block" (strcat "" (itoa (1+ base))))
        (setq base (1+ base))
      ); while
      (repeat (setq n (sslength ss))
        (setq pl (ssname ss (setq n (1- n))))
        (setq ar (vlax-curve-getArea pl))
        (vla-getBoundingBox (vlax-ename->vla-object pl) 'll 'ur)
        (mapcar 'set '(ll ur) (mapcar 'safearray-value (list ll ur)))
        (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) ll ur))
        (command "_.attdef" "" (itoa (+ base n)) "" "" "_none" mp (getvar 'textsize) "")
        (setq att (entlast))
        (command
          "_.block" (setq blk (itoa (+ base n))); increment Block name
            "_none" (trans (vlax-curve-getStartPoint pl) 0 1)
            pl att ""
          "_.insert" blk "_none" "@" "" "" "" ar
        ); command
      ); repeat
    ); progn
  ); if
  (*error* nil)
); defun

Thank you very much @marko_ribar.Only the increment of the block name doesn't work. And i can use  only one time this command.

[marko_ribar]

Here, check it now...

 

(defun C:P2B (/ *error* atd ss base n pl ar ll ur mp att blk); = Polylines [to] Blocks

  (vl-load-com)

  (defun *error* (m)
    (if atd
      (setvar 'attdia atd)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (setq atd (getvar 'attdia))
  (setvar 'attdia 0)
  (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))))
    (progn ; then
      (setq base 0 n -1)
      (while (tblsearch "block" (itoa (+ (1+ base) n)))
        (setq base (1+ base))
      ); while
      (while (tblsearch "block" (itoa (+ base (1+ n))))
        (setq n (1+ n))
      ); while
      (setq n -1)
      (repeat (sslength ss)
        (setq pl (ssname ss (setq n (1+ n))))
        (while (tblsearch "block" (itoa (+ (1+ base) n)))
          (setq base (1+ base))
        ); while
        (setq ar (vlax-curve-getArea pl))
        (vla-getBoundingBox (vlax-ename->vla-object pl) 'll 'ur)
        (mapcar 'set '(ll ur) (mapcar 'safearray-value (list ll ur)))
        (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) ll ur))
        (command "_.attdef" "" "TAG" "" "" "_none" mp (getvar 'textsize) "")
        (setq att (entlast))
        (command
          "_.block" (setq blk (itoa (+ base n))); increment Block name
            "_none" (trans (vlax-curve-getStartPoint pl) 0 1)
            pl att ""
          "_.insert" blk "_none" "@" "" "" "" ar
        ); command
      ); repeat
    ); progn
  ); if
  (*error* nil)
); defun

 

Edited June 1, 2023 by marko_ribar

[mhupp]

I have said before. You want more then just a generic block name if you are going to at any point move blocks between drawings.