Nhờ viết Lisp di chuyển các Block thuộc tính

[hainguyen2014 12]

Xin chào,

Hiện tại, mình đang làm bản vẽ phân lớp đất. Khi xuất dữ liệu phân lớp thì các block chồng lấn lên nhau rất khó đọc. Do vậy, mình phải kéo các Block attribute ra bên ngoài giãn cách với nhau 1 khoảng để trình bày bản vẽ rõ ràng hơn. Nhưng với số lượng các đối tượng nhiều, nếu làm thủ công từng block sẽ tốn nhiều thời gian.

Mình nhờ các bạn viết giúp Lisp dể chọn nhóm Block cùng di chuyển ra 1 vị trí bất kỳ, đồng thời tự giãn cách các dòng 1 khoảng cố định.

Cảm ơn các bạn nhiều!

Drawing1.dwg

[cuongtk2 199]

Cơ bản như thế này

(defun c:test ( / D E I N OBJ PT SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))))
(setq n (length ss)
      i 0)
(vl-sort ss '(lambda (e1 e2) (> (cadr (acet-dxf 10 (entget e1)))
                               (cadr (acet-dxf 10 (entget e2)))
                               )) )
(setq pt (getpoint "\nVi tri moi")
      d (getdist "\nKhoang dan dong" pt))
(while (< i  n)
  (progn
    (setq e (nth i ss)
      obj (vlax-ename->vla-object e))
    (vla-put-InsertionPoint obj (vlax-3d-point(polar pt (* pi 1.5) (* d i))))
    )
  (setq i (1+ i))
  )
  (princ)
  )

         

 

[hainguyen2014 12]

2 giờ trước, cuongtk2 đã nói:

Cơ bản như thế này

• test.lsp
  
• [✎]
   

(defun c:test ( / D E I N OBJ PT SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))))
(setq n (length ss)
      i 0)
(vl-sort ss '(lambda (e1 e2) (> (cadr (acet-dxf 10 (entget e1)))
                               (cadr (acet-dxf 10 (entget e2)))
                               )) )
(setq pt (getpoint "\nVi tri moi")
      d (getdist "\nKhoang dan dong" pt))
(while (< i  n)
  (progn
    (setq e (nth i ss)
      obj (vlax-ename->vla-object e))
    (vla-put-InsertionPoint obj (vlax-3d-point(polar pt (* pi 1.5) (* d i))))
    )
  (setq i (1+ i))
  )
  (princ)
  )

         

 

Cảm ơn bạn. Có một số vấn đề nhờ bạn điều chỉnh giúp:

- Vị trí điểm chèn là cố định, chỉ dịch chuyển (stretch) Block là bên ngoài cho dễ nhìn như minh họa.

- Thứ tự block phải giữ nguyên sau khi dịch chuyển.

Bạn sửa lại Lisp giúp minh nhé! 

[thiep 359]

4 giờ trước, cuongtk2 đã nói:

Cơ bản như thế này

• test.lsp
  
• [✎]
   

(defun c:test ( / D E I N OBJ PT SS)
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))))
(setq n (length ss)
      i 0)
(vl-sort ss '(lambda (e1 e2) (> (cadr (acet-dxf 10 (entget e1)))
                               (cadr (acet-dxf 10 (entget e2)))
                               )) )
(setq pt (getpoint "\nVi tri moi")
      d (getdist "\nKhoang dan dong" pt))
(while (< i  n)
  (progn
    (setq e (nth i ss)
      obj (vlax-ename->vla-object e))
    (vla-put-InsertionPoint obj (vlax-3d-point(polar pt (* pi 1.5) (* d i))))
    )
  (setq i (1+ i))
  )
  (princ)
  )

         

 

He he, đây là các block động chứ có phải block thường đâu mà mà viết vậy @cuongtk2

Đề bài đặt ra cũng hay, mong @cuongtk2 viết nốt phần còn lại khi xử lý các block động.

[hainguyen2014 12]

7 giờ trước, thiep đã nói:

He he, đây là các block động chứ có phải block thường đâu mà mà viết vậy @cuongtk2

Đề bài đặt ra cũng hay, mong @cuongtk2 viết nốt phần còn lại khi xử lý các block động.

Dạ, đúng theo yêu cầu rồi anh ạ!

Anh gửi lisp cho em tham khảo với nhé!

Cảm ơn anh nhiều!

[cuongtk2 199]

Thật xin lỗi vì đã không mở bản vẽ ra xem. Cái này đã sửa lại rồi nha.

(defun c:test ( / D E I N OBJ PT SS INS P0 X X1 Y Y1)

  ;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil
 
(defun LM:setdynpropvalue ( blk prp val )
    (setq prp (strcase prp))
    (vl-some
       '(lambda ( x )
            (if (= prp (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                    (cond (val) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

  
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))))
(setq n (length ss)
      i 0)
(setq ss (vl-sort ss '(lambda (e1 e2) (> (cadr (acet-dxf 10 (entget e1)))
                               (cadr (acet-dxf 10 (entget e2)))
                               )) )
)
(setq pt (getpoint "\nVi tri moi")
      d (getdist "\nKhoang dan dong" pt))
(while (< i  n)
  (progn
    (setq e (nth i ss)
          
      obj (vlax-ename->vla-object e)
          p0 (acet-dxf 10 (entget e))
          x1 (car p0) y1 (cadr p0)
          ins (polar pt (* pi 1.5) (* d i))
          x (car ins) y (cadr ins))
    
    (LM:setdynpropvalue obj "Position X" (- x x1))
    (LM:setdynpropvalue obj "Position Y" (- y y1))
    )
  (setq i (1+ i))
  )
  (princ)
  )

 

[hainguyen2014 12]

43 phút trước, cuongtk2 đã nói:

Thật xin lỗi vì đã không mở bản vẽ ra xem. Cái này đã sửa lại rồi nha.

• test.lsp
  
• [✎]
   

(defun c:test ( / D E I N OBJ PT SS INS P0 X X1 Y Y1)

  ;; prp - [str] Dynamic Block property name (case-insensitive)
; val - [any] New value for property
; Returns: [any] New value if successful, else nil
 
(defun LM:setdynpropvalue ( blk prp val )
    (setq prp (strcase prp))
    (vl-some
       '(lambda ( x )
            (if (= prp (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                    (cond (val) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

  
(setq ss (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))))
(setq n (length ss)
      i 0)
(vl-sort ss '(lambda (e1 e2) (> (cadr (acet-dxf 10 (entget e1)))
                               (cadr (acet-dxf 10 (entget e2)))
                               )) )
(setq pt (getpoint "\nVi tri moi")
      d (getdist "\nKhoang dan dong" pt))
(while (< i  n)
  (progn
    (setq e (nth i ss)
          
      obj (vlax-ename->vla-object e)
          p0 (acet-dxf 10 (entget e))
          x1 (car p0) y1 (cadr p0)
          ins (polar pt (* pi 1.5) (* d i))
          x (car ins) y (cadr ins))
    
    (LM:setdynpropvalue obj "Position X" (- x x1))
    (LM:setdynpropvalue obj "Position Y" (- y y1))
    )
  (setq i (1+ i))
  )
  (princ)
  )

 

Dạ, còn một chút vấn đề nữa là Các Block sau khi dịch chuyển phải giữ nguyên thứ tự. Anh chỉnh giúp em với nhé! Tks anh!

 

[cuongtk2 199]

Đã sửa lại (code phía trên nhé)

[hainguyen2014 12]

16 phút trước, cuongtk2 đã nói:

Đã sửa lại (code phía trên nhé)

Tuyệt vời! 

Cảm ơn anh nhé!