Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
hainguyen2014

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

Các bài được khuyến nghị

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!

image.thumb.png.6dc12a3e22364b435e2bf741271e17bd.png

Drawing1.dwg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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)
  )

         

 

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
2 giờ trước, cuongtk2 đã nói:

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)
  )

         

 

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é! 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
4 giờ trước, cuongtk2 đã nói:

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)
  )

         

 

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.

A6OYlj.gif

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

A6OYlj.gif

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!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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)
  )

 

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.


(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!

image.png.4ad2ef4c7b5727f76da193e4c8f0de9c.png

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×