Lisp convert các polyline sang block

Trong một số trường hợp, có thể bạn cần convert các polyline sang block để dễ dàng cho việc quản lý và chỉnh sửa.

Bài viết này cung cấp các câu lệnh lisp để thực hiện việc convert các polyline thành các block.

Trường hợp 1: Convert tất cả các polyline được chọn, mỗi polyline là một block. Tất cả các block đều có chung 1 tên

Mã lệnh lisp như sau:

(defun C:testP2B (/ ss base n blk pl ANG ANG0 AUNITSS MIDPT MIDPT0 PL0)

(SETQ AUNITSS (GETVAR "AUNITS"))
(SETVAR "AUNITS" 3)
  
  
  (if (setq ss (ssget  '((0 . "*POLYLINE"))))
    (progn ; then
    (setq pl0 (ssname ss 0))
    (setq midpt0 (vlax-curve-getStartPoint pl0))
    (setq
  ang0
    (angle
      '(0 0 0)
      (vlax-curve-getFirstDeriv
        pl0
        0 
      ); end 1st deriv
    ); end angle & ang
)
    
    (if (not (tblsearch "block" "P2B"))

      (command
        "_.block" "P2B"
          "_none" midpt0
          pl0 ""
        "_.insert" "P2B" "_none" "@" "" "" (rtos ang0 2 3)
      )
      
      )

 (setq n 0)
    (repeat (- (sslength ss) 1)
      (setq n (+ 1 n))
      (setq pl (ssname ss n))
      (setq midpt (vlax-curve-getStartPoint pl))
      (setq
  ang
    (angle
      '(0 0 0)
      (vlax-curve-getFirstDeriv
        pl
        0 
      ); end 1st deriv
    ); end angle & ang
)

      
      
      (command "_.insert" "P2B" midpt 1 1 (rtos (- ang ang0) 2 3))

      
    ); repeat
    
    ); progn
  ); if


(SETVAR "AUNITS" aunitss)
  
  
); defun

Trường hợp 2: Convert tất cả các polyline được chọn, mỗi polyline thành một block. Mỗi block có một tên riêng.

Mã lệnh như sau:

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

Cách sử dụng lisp:
Copy đoạn mã lệnh trên vào file txt bất kỳ, save as lại với đuôi .lsp.
Mở Autocad load lisp lên và sử dụng.