[Request] Tự Động Ghi Chú Đoạn Thẳng Theo Thứ Tự Tăng Dần

[conghoa 123]

Chào các bạn, mình có vấn đề này mong các bạn giúp đỡ.

 

Hiện tại mình có một bản vẽ với rất nhiều đoạn thẳng, nhiệm vụ của mình là phải đánh ký hiệu theo thứ tự (A01, A02 ... AN) cho các đoạn thẳng đó và ghi kích thước cho các đoạn thẳng đó. Các đoạn thẳng có kích thước bằng nhau sẽ là cùng 1 ký hiệu, mình muốn các bạn giúp mình một lisp để rút ngắn thời gian làm công việc này.

 

Mình xin mô tả lisp như sau:

- Chạy lisp

+ Lisp yêu cầu chọn các đoạn thẳng cần ghi ký hiệu

- Người dùng chọn (có thể chọn kích từng đoạn, hoặc và gom tất cả)

+ Lisp yêu cầu chọn block att điển hình để thực hiện lệnh (block att này mình đã làm trong file đính kèm)

- Người dùng chọn block điển hình

+ Lisp yêu cầu nhập ký hiệu bắt đầu (ví dụ: A01 hoặc B04)

- Người dùng điền ký hiệu

+ Lisp sẽ copy block điển hình (theo điểm chèn block) vào giữa đoạn thẳng và thực hiện việc ghi ký hiệu và độ dài của các đoạn thẳng được chọn vào block att đó. Lưu ý là các đoạn thẳng có độ dài bằng nhau thì sẽ có cùng ký hiệu và dựa vào ký hiện bắt đầu do người dùng chọn để tăng thứ tự cho các đoạn thẳng tiếp theo.

Kết thúc lisp sau khi đã ghi hết các đoạn thẳng.

 

file mẫu:

http://www.mediafire.com/file/xk49d64p284c672/Vidu.dwg

 

Cảm ơn các bạn trước nhé.

 

Trân trọng!

[Tue_NV 3.912]

Bạn thử xem; 

(defun attfill (Lobjfind Lrep)
(mapcar '(lambda(x y)
(vlax-put x 'textstring y)
)
Lobjfind
 Lrep 
)
)
(defun Tue-geom-divpt (p1 p2 k)
(polar p1 (angle p1 p2) (* (distance p1 p2) k))
)
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
 (setq i -1)
(if (and (setq ss (ssget '((0 . "*LINE")))) (setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :")))
  (while (setq ename (ssname ss (setq i (1+ i))))
    (setq lst-length (append lst-length (list (list (vlax-ename->vla-object ename)
   (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename))
   (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5)))))
  )
)
  (setq lst-length (vl-sort  lst-length '(lambda (x1 x2) (< (cadr x1) (cadr x2)))))
  (setq lst-re (mapcar 'cadr lst-length ))
  (setq kq (car lst-re) lst-kq '(0))
  (foreach x lst-re
    (if (= x kq) (setq lst-kq (append lst-kq (list (last lst-kq))))
       (setq kq x lst-kq (append lst-kq (list (1+ (last lst-kq)))) )
    )
  )
  (setq lst-kq (cdr lst-kq)) 
    
  (setq i 0)
  (foreach x lst-length
(attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-3d-point (caddr x)) "BlockKH" 1 1 1 0) 'getattributes)
(list "GOC" (cadr x) (strcat tto (if (< (setq kq (+ ttu (nth i lst-kq))) 10) (strcat "0" (itoa kq)) (itoa kq))))
)
        (setq i (1+ i))
   )
)

[conghoa 123]

wao, đoạn code ngắn mà làm được khối lượng công việc quá nhiều bác ạ. Thanks bác Tue_NV nhé!

 

Bác cho em hỏi thêm chút, bác có thể chỉnh giúp cho số thứ tự của Block sẽ hiện theo thứ tự người dùng chọn đường Line được không? Vì cái bác đang viết là số thứ tự sẽ được tăng dần theo chiều dài của Line thì phải.

 

Trân trọng!

[Tue_NV 3.912]

wao, đoạn code ngắn mà làm được khối lượng công việc quá nhiều bác ạ. Thanks bác Tue_NV nhé!

 

Bác cho em hỏi thêm chút, bác có thể chỉnh giúp cho số thứ tự của Block sẽ hiện theo thứ tự người dùng chọn đường Line được không? Vì cái bác đang viết là số thứ tự sẽ được tăng dần theo chiều dài của Line thì phải.

 

Trân trọng!

Ý bạn như vầy:

 

(defun attfill (Lobjfind Lrep) (mapcar '(lambda(x y) (vlax-put x 'textstring y)) Lobjfind Lrep ))
(defun Tue-geom-divpt (p1 p2 k) (polar p1 (angle p1 p2) (* (distance p1 p2) k)))
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
(setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :") ttu0 ttu)
  (while (setq ename (car (entsel "Chon Line :")))
       (setq L-length (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename)))
    (if (null (member L-length lst-length))
        (setq kq (strcat tto (if (< ttu 10) (strcat "0" (itoa ttu)) (itoa ttu)))
          lst-length (append lst-length (list L-length)) ttu (1+ ttu))
        (setq vitri (VL-POSITION L-length lst-length)
          kq (strcat tto (if (< (+ ttu0 vitri) 10) (strcat "0" (itoa (+ ttu0 vitri))) (itoa (+ ttu0 vitri))))
        )
    )  
        (attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vlax-3d-point (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5))
        "BlockKH" 1 1 1 0) 'getattributes)
         (list "GOC" (rtos L-length 2 0) kq)
    )
  )
(princ)
)

[conghoa 123]

hé hé, thanks bác nhiều :D ... 

[conghoa 123]

 

Ý bạn như vầy:

(defun attfill (Lobjfind Lrep) (mapcar '(lambda(x y) (vlax-put x 'textstring y)) Lobjfind Lrep ))
(defun Tue-geom-divpt (p1 p2 k) (polar p1 (angle p1 p2) (* (distance p1 p2) k)))
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
(setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :") ttu0 ttu)
  (while (setq ename (car (entsel "Chon Line :")))
       (setq L-length (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename)))
    (if (null (member L-length lst-length))
        (setq kq (strcat tto (if (< ttu 10) (strcat "0" (itoa ttu)) (itoa ttu)))
          lst-length (append lst-length (list L-length)) ttu (1+ ttu))
        (setq vitri (VL-POSITION L-length lst-length)
          kq (strcat tto (if (< (+ ttu0 vitri) 10) (strcat "0" (itoa (+ ttu0 vitri))) (itoa (+ ttu0 vitri))))
        )
    )  
        (attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vlax-3d-point (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5))
        "BlockKH" 1 1 1 0) 'getattributes)
         (list "GOC" (rtos L-length 2 0) kq)
    )
  )
(princ)
)

 

Bác Tue_NV chỉnh giúp em phần này với:

 

- Khi chọn line mà kích trượt ko vào line mà ra bên ngoài là nó kết thúc lệnh luôn, bác chỉnh giúp em là kết thúc lệnh khi mình ấn ESC với. Để nếu có chọn trượt thì vẫn có thể chọn tiếp.

 

Trân trọng!

[Tue_NV 3.912]

Bác Tue_NV chỉnh giúp em phần này với:

 

- Khi chọn line mà kích trượt ko vào line mà ra bên ngoài là nó kết thúc lệnh luôn, bác chỉnh giúp em là kết thúc lệnh khi mình ấn ESC với. Để nếu có chọn trượt thì vẫn có thể chọn tiếp.

 

Trân trọng!

 

Bạn thử coi có được không?

 

(defun attfill (Lobjfind Lrep) (mapcar '(lambda(x y) (vlax-put x 'textstring y)) Lobjfind Lrep ))
(defun Tue-geom-divpt (p1 p2 k) (polar p1 (angle p1 p2) (* (distance p1 p2) k)))
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
(setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :") ttu0 ttu)
  (while (setq ename (car (entsel "Chon Line :")))
   (if ename (progn
       (setq L-length (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename)))
    (if (null (member L-length lst-length))
        (setq kq (strcat tto (if (< ttu 10) (strcat "0" (itoa ttu)) (itoa ttu)))
          lst-length (append lst-length (list L-length)) ttu (1+ ttu))
        (setq vitri (VL-POSITION L-length lst-length)
          kq (strcat tto (if (< (+ ttu0 vitri) 10) (strcat "0" (itoa (+ ttu0 vitri))) (itoa (+ ttu0 vitri))))
        )
    )  
        (attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vlax-3d-point (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5))
        "BlockKH" 1 1 1 0) 'getattributes)
         (list "GOC" (rtos L-length 2 0) kq)
    )
   ))
  )
(princ)
)

[Chym Code 10]

Khi đọc đề bài em thấy khá thú vị, có thể ứng dụng được nhiều việc, nhưng phần file ví dụ của bác thớt em ko down về được, nên không hình dung ra được các att của bác tạo ra có mục đích như thế nào. Bác có thể gửi lại giúp em file ví dụ của bác được không, em cũng muốn vọc lip này !

Mong sớm nhận được phản hồi của bác

[quocmanh04tt 634]

Bạn tạo 1 block có 3 Att với tên là: BlockKH.

Trong đó:

+ 1 Att - để ghi ký hiệu

+ 1 Att - để ghi chiều dài

+ 1 Att - để ghi góc

Rồi muốn vọc gì thì vọc.

[Chym Code 10]

Bạn tạo 1 block có 3 Att với tên là: BlockKH.

Trong đó:

+ 1 Att - để ghi ký hiệu

+ 1 Att - để ghi chiều dài

+ 1 Att - để ghi góc

Rồi muốn vọc gì thì vọc.

cảm ơn bác chỉ điểm !

[conghoa 123]

 

Bạn thử coi có được không?

(defun attfill (Lobjfind Lrep) (mapcar '(lambda(x y) (vlax-put x 'textstring y)) Lobjfind Lrep ))
(defun Tue-geom-divpt (p1 p2 k) (polar p1 (angle p1 p2) (* (distance p1 p2) k)))
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
(setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :") ttu0 ttu)
  (while (setq ename (car (entsel "Chon Line :")))
   (if ename (progn
       (setq L-length (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename)))
    (if (null (member L-length lst-length))
        (setq kq (strcat tto (if (< ttu 10) (strcat "0" (itoa ttu)) (itoa ttu)))
          lst-length (append lst-length (list L-length)) ttu (1+ ttu))
        (setq vitri (VL-POSITION L-length lst-length)
          kq (strcat tto (if (< (+ ttu0 vitri) 10) (strcat "0" (itoa (+ ttu0 vitri))) (itoa (+ ttu0 vitri))))
        )
    )  
        (attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vlax-3d-point (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5))
        "BlockKH" 1 1 1 0) 'getattributes)
         (list "GOC" (rtos L-length 2 0) kq)
    )
   ))
  )
(princ)
)

Vẫn không được bác ạ, chọn sai là kết thúc luôn

[quocmanh04tt 634]

Tham gia 1 cái:

- Chỉ dùng cho LINE.

- Quét chọn chứ không pick.

- Block do lisp tự tạo => trong file bản vẽ không cần có block trước.

- Có tùy chọn điều chỉnh bán kính vòng tròn.

=> Link: https://drive.google.com/file/d/0B2LetfHDljPGdGIxM0NpaDlYREk/view?usp=sharing

[Tue_NV 3.912]

Vẫn không được bác ạ, chọn sai là kết thúc luôn

 

Bạn thử laị code này. Chọn sai cho chọn lại. Chọn kiểu select object. Cho phép chọn 1 lần nhiều đối tượng

 

(defun attfill (Lobjfind Lrep) (mapcar '(lambda(x y) (vlax-put x 'textstring y)) Lobjfind Lrep ))
(defun Tue-geom-divpt (p1 p2 k) (polar p1 (angle p1 p2) (* (distance p1 p2) k)))
(defun c:ttt(/ i  tto ename lst-length ss ename lst-re kq ls-kq ttu)
(setq tto (getstring t "\nNhap tien to :")) (setq ttu (getint "\nThu tu :") ttu0 ttu )
  (while (setq ss (ssget '((0 . "*LINE"))))
    (setq i -1)
  (while (setq ename (ssname ss (setq i (1+ i))))
 
       (setq L-length (vlax-curve-getDistAtPoint ename (vlax-curve-getEndPoint ename)))
    (if (null (member L-length lst-length))
        (setq kq (strcat tto (if (< ttu 10) (strcat "0" (itoa ttu)) (itoa ttu)))
              lst-length (append lst-length (list L-length)) ttu (1+ ttu))
        (setq vitri (VL-POSITION L-length lst-length)
              kq (strcat tto (if (< (+ ttu0 vitri) 10) (strcat "0" (itoa (+ ttu0 vitri))) (itoa (+ ttu0 vitri))))
        )
    )  
        (attfill (vlax-invoke (vla-InsertBlock (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vlax-3d-point (Tue-geom-divpt (vlax-curve-getstartPoint ename) (vlax-curve-getEndPoint ename) 0.5))
        "BlockKH" 1 1 1 0) 'getattributes)
         (list "GOC" (rtos L-length 2 0) kq)
    )
  )
    )
(princ)
)