Nhờ sửa lisp tạo block nhanh

[DNcouples 2]

Chào mọi người, em có tìm được lisp này để tạo block nhanh, nhưng có vấn đề là tên mà lisp này tự tạo dễ bị trùng quá (nó có dạng ABC_001...)
Em cần sửa lại phần đặt tên block sẽ là 1 chuỗi random 10 ký tự để khó bị trùng hơn, mong mọi người giúp đỡ!

Quote

Quote

 

 

(defun c:QB (/ selectionset insertionpoint number Blockname)
  ;;; Tharwat 11. May. 2012 ;;
  (if (and (setq selectionset (ssget "_:L"))
           (setq insertionpoint (getpoint "\n Specify insertion point :"))
      )
    (progn
      (setq number    1
            Blockname (strcat "MyBlock" (itoa number))
      )
      (while (tblsearch "BLOCK" Blockname)
        (setq Blockname
               (strcat "MyBlock" (itoa (setq number (1+ number))))
        )
      )
      (command "_.-Block" Blockname insertionpoint selectionset "")
      (command "_.-insert" Blockname insertionpoint "" "" "")
    )
    (princ)
  )
  (princ)
)

 

[quangcda 7]

Lisp này người viết đã lường trước trường hợp trùng tên rồi bạn, nên bạn không phải lo trùng đâu! Còn nếu bạn không thích MyBlock thì đổi thành chữ gì đó thôi.

[Doan Nguyen Van 492]

Chủ topic đang tính đến khi copy block qua lại giữa các bản vẽ, sẽ bị trùng tên và không copy được

Cách giải quyết đơn giản là cho thêm 1 chuỗi ngày tháng năm giờ phút giây phía sau đảm bảo sẽ không bị trùng nữa

[Xuân Lộc 11]

mình nhớ lisp dạng này có người viết rồi mà nhỉ, có bác @Duong Nhat Duy cũng có, dạng này mk thích xài loại chọn được điểm đặt cho nó linh động

[Nguyễn Hà Huy 41]

Lisp của bác @Duong Nhat Duy viết mà mình đang dùng, b tham khảo, lệnh B chọn tâm giữa, BB chọn tâm tuỳ chọn do mk gộp 2 lisp riêng vào :D

Block Quick (Lenh B - BB).lsp

[DNcouples 2]

7 giờ trước, Nguyễn Hà Huy đã nói:

Lisp của bác @Duong Nhat Duy viết mà mình đang dùng, b tham khảo, lệnh B chọn tâm giữa, BB chọn tâm tuỳ chọn do mk gộp 2 lisp riêng vào :D

Block Quick (Lenh B - BB).lsp

đúng lisp em cần luôn, cảm ơn anh

[DNcouples 2]

8 giờ trước, Doan Nguyen Van đã nói:

Chủ topic đang tính đến khi copy block qua lại giữa các bản vẽ, sẽ bị trùng tên và không copy được

Cách giải quyết đơn giản là cho thêm 1 chuỗi ngày tháng năm giờ phút giây phía sau đảm bảo sẽ không bị trùng nữa

Đúng rồi anh, em có thấy cách lấy thời gian tạo block để đặt tên mà ko rành lisp nên mò hoài ko ra. Anh giúp em sửa lisp trên theo ý đó được ko

[Lê Quang Dương 9]

15 giờ trước, DNcouples đã nói:

Đúng rồi anh, em có thấy cách lấy thời gian tạo block để đặt tên mà ko rành lisp nên mò hoài ko ra. Anh giúp em sửa lisp trên theo ý đó được ko

;; Quick Block - Creates Block from selected objects
(defun C:QB (/ SS blkname mpt ptslst minpt maxpt LL UR)
  (if (setq SS (ssget))
    (progn
      (if (or (eq (setq blkname (getstring T "\nBlock Name: ")) "") (/= (tblsearch "block" blkname) nil))
        (Set_blkname)
      )
      (if (not (setq MPT (getpoint "\nSpecify Base Point: ")))
        (progn
          (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
            (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
            (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                  ptslst (cons (vlax-safearray->list maxpt) ptslst)
            )
          )
          (setq LL (apply 'mapcar (cons 'min ptslst))
                UR (apply 'mapcar (cons 'max ptslst))
                MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
          )
        )
      )
      (vl-cmdf "_.Block" blkname "_non" MPT SS "")
      (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0)
      (prompt (strcat "\nBlock [" blkname "] Was Created."))
    )
    (prompt "\nNothing Selected")
  )
  (princ)
)

(defun Set_BlkName ()
  (setq o-dmzn (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq time (rtos (getvar "CDATE") 2 6)) ; Format YYYYMMDD.HHMMSS
  (setq dtime (substr (rtos (getvar "DATE") 2 9) 13 5))
  (setq blkname (strcat "A" time "." dtime))
  (setvar "dimzin" o-dmzn)
  (princ)
)

[Lê Quang Dương 9]

1 phút trước, Lê Quang Dương đã nói:

;; Quick Block - Creates Block from selected objects
(defun C:QB (/ SS blkname mpt ptslst minpt maxpt LL UR)
  (if (setq SS (ssget))
    (progn
      (if (or (eq (setq blkname (getstring T "\nBlock Name: ")) "") (/= (tblsearch "block" blkname) nil))
        (Set_blkname)
      )
      (if (not (setq MPT (getpoint "\nSpecify Base Point: ")))
        (progn
          (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
            (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
            (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                  ptslst (cons (vlax-safearray->list maxpt) ptslst)
            )
          )
          (setq LL (apply 'mapcar (cons 'min ptslst))
                UR (apply 'mapcar (cons 'max ptslst))
                MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
          )
        )
      )
      (vl-cmdf "_.Block" blkname "_non" MPT SS "")
      (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0)
      (prompt (strcat "\nBlock [" blkname "] Was Created."))
    )
    (prompt "\nNothing Selected")
  )
  (princ)
)

(defun Set_BlkName ()
  (setq o-dmzn (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq time (rtos (getvar "CDATE") 2 6)) ; Format YYYYMMDD.HHMMSS
  (setq dtime (substr (rtos (getvar "DATE") 2 9) 13 5))
  (setq blkname (strcat "A" time "." dtime))
  (setvar "dimzin" o-dmzn)
  (princ)
)

Lisp này có thể đặt tên hoặc nhấn Enter để tự động đặt theo ngày tháng năm giờ phút giây. Điểm chèn có thể chọn hoặc nhấn Enter để tự động chọn tâm đối tượng. Nhược điểm là không thể tạo block trong môi trường chỉnh sửa block.

[Nguyễn Hà Huy 41]

1 giờ} trướ}c, Lê Quang Dương đã nói:

Lisp này có thể đặt tên hoặc nhấn Enter để tự động đặt theo ngày tháng năm giờ phút giây. Điểm chèn có thể chọn hoặc nhấn Enter để tự động chọn tâm đối tượng. Nhược điểm là không thể tạo block trong môi trường chỉnh sửa block.

mk góp ý là lisp tự đặt tên block luôn, có ngày tháng năm giờ phút giây là ko bao giờ có chuyện bị trùng tên block rồi, còn đặt tên block thủ công có lệnh gốc của cad làm nhiệm vụ đó, chắc ăn nữa là thêm tên bản vẽ vào chỗ ngày tháng năm nữa là chắc lịch

[DNcouples 2]

1 giờ} trướ}c, Lê Quang Dương đã nói:

Lisp này có thể đặt tên hoặc nhấn Enter để tự động đặt theo ngày tháng năm giờ phút giây. Điểm chèn có thể chọn hoặc nhấn Enter để tự động chọn tâm đối tượng. Nhược điểm là không thể tạo block trong môi trường chỉnh sửa block.

cảm ơn anh

[Xuân Lộc 11]

14 giờ trước, Lê Quang Dương đã nói:

;; Quick Block - Creates Block from selected objects
(defun C:QB (/ SS blkname mpt ptslst minpt maxpt LL UR)
  (if (setq SS (ssget))
    (progn
      (if (or (eq (setq blkname (getstring T "\nBlock Name: ")) "") (/= (tblsearch "block" blkname) nil))
        (Set_blkname)
      )
      (if (not (setq MPT (getpoint "\nSpecify Base Point: ")))
        (progn
          (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
            (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
            (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                  ptslst (cons (vlax-safearray->list maxpt) ptslst)
            )
          )
          (setq LL (apply 'mapcar (cons 'min ptslst))
                UR (apply 'mapcar (cons 'max ptslst))
                MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
          )
        )
      )
      (vl-cmdf "_.Block" blkname "_non" MPT SS "")
      (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0)
      (prompt (strcat "\nBlock [" blkname "] Was Created."))
    )
    (prompt "\nNothing Selected")
  )
  (princ)
)

(defun Set_BlkName ()
  (setq o-dmzn (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq time (rtos (getvar "CDATE") 2 6)) ; Format YYYYMMDD.HHMMSS
  (setq dtime (substr (rtos (getvar "DATE") 2 9) 13 5))
  (setq blkname (strcat "A" time "." dtime))
  (setvar "dimzin" o-dmzn)
  (princ)
)

anh sửa giúp em code tự đặt tên block với ạ, với khi đặt block thì block luôn luôn ở đơn vị minimet nữa ạ. thank anh

[vietduc147258 88]

21 giờ trước, Xuân Lộc đã nói:

anh sửa giúp em code tự đặt tên block với ạ, với khi đặt block thì block luôn luôn ở đơn vị minimet nữa ạ. thank anh

Tại sao không Units đi rồi hãy tạo Block. Chứ bản vẽ đang Units là Inch mà ép Block nó theo mm là kích thước tùm lum luôn đó

Đặt tên thì OK, bỏ qua pick điểm thì thôi nhé.

(defun c:QB (/ selectionset insertionpoint number Blockname)
  ;;; Tharwat 11. May. 2012 ;;
  (if (and (setq selectionset (ssget "_:L"))
           (setq insertionpoint (getpoint "\n Specify insertion point :"))
      )
    (progn
      (setq  Blockname (strcat (substr (getvar "dwgname") 1 5 ) (menucmd "M=$(edtime, $(getvar,date),_DDMO_HHMMSS)")))
      (while (tblsearch "BLOCK" Blockname)
        (setq Blockname
               (strcat Blockname "n")
        )
      )
      (command "_.-Block" Blockname insertionpoint selectionset "")
      (command "_.-insert" Blockname insertionpoint "" "" "")
    )
    (princ)
  )
  (princ)
)

 

[Xuân Lộc 11]

Vào lúc 6/11/2024 tại 08:25, vietduc147258 đã nói:

Tại sao không Units đi rồi hãy tạo Block. Chứ bản vẽ đang Units là Inch mà ép Block nó theo mm là kích thước tùm lum luôn đó

Đặt tên thì OK, bỏ qua pick điểm thì thôi nhé.

(defun c:QB (/ selectionset insertionpoint number Blockname)
  ;;; Tharwat 11. May. 2012 ;;
  (if (and (setq selectionset (ssget "_:L"))
           (setq insertionpoint (getpoint "\n Specify insertion point :"))
      )
    (progn
      (setq  Blockname (strcat (substr (getvar "dwgname") 1 5 ) (menucmd "M=$(edtime, $(getvar,date),_DDMO_HHMMSS)")))
      (while (tblsearch "BLOCK" Blockname)
        (setq Blockname
               (strcat Blockname "n")
        )
      )
      (command "_.-Block" Blockname insertionpoint selectionset "")
      (command "_.-insert" Blockname insertionpoint "" "" "")
    )
    (princ)
  )
  (princ)
)

 

cảm ơn anh đã quan tâm, anh có thể bỏ phần đặt tên thủ công ở lisp của anh Lê Quang Dương được ko ạ, còn cái units là nhu cầu riêng thôi anh có cũng đc ko có cũng ko sao.

;; Quick Block - Creates Block from selected objects
(defun C:QB (/ SS blkname mpt ptslst minpt maxpt LL UR)
  (if (setq SS (ssget))
    (progn
      (if (or (eq (setq blkname (getstring T "\nBlock Name: ")) "") (/= (tblsearch "block" blkname) nil))
        (Set_blkname)
      )
      (if (not (setq MPT (getpoint "\nSpecify Base Point: ")))
        (progn
          (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
            (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
            (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                  ptslst (cons (vlax-safearray->list maxpt) ptslst)
            )
          )
          (setq LL (apply 'mapcar (cons 'min ptslst))
                UR (apply 'mapcar (cons 'max ptslst))
                MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
          )
        )
      )
      (vl-cmdf "_.Block" blkname "_non" MPT SS "")
      (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0)
      (prompt (strcat "\nBlock [" blkname "] Was Created."))
    )
    (prompt "\nNothing Selected")
  )
  (princ)
)

(defun Set_BlkName ()
  (setq o-dmzn (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq time (rtos (getvar "CDATE") 2 6)) ; Format YYYYMMDD.HHMMSS
  (setq dtime (substr (rtos (getvar "DATE") 2 9) 13 5))
  (setq blkname (strcat "A" time "." dtime))
  (setvar "dimzin" o-dmzn)
  (princ)
)

[vietduc147258 88]

4 giờ trước, Xuân Lộc đã nói:

cảm ơn anh đã quan tâm, anh có thể bỏ phần đặt tên thủ công ở lisp của anh Lê Quang Dương được ko ạ, còn cái units là nhu cầu riêng thôi anh có cũng đc ko có cũng ko sao.

      (if (or (eq (setq blkname (getstring T "\nBlock Name: ")) "") (/= (tblsearch "block" blkname) nil))
        (Set_blkname)
      )

Haha. Bạn này vui tính quá. Không rảnh về lisp lắm nên bạn không tô màu thì cũng chịu rồi. Xin phép tác giả nha.

Cái này bỏ hết đoạn đó đi. thay bằng (Set_Blkname) thôi bạn. Bỏ vậy hình như bỏ luôn cái kiểm tra tên có chưa. Nhưng chắc không sao đâu. 

[NTHAHT 103]

Vào lúc 5/11/2024 tại 10:57, Xuân Lộc đã nói:

anh sửa giúp em code tự đặt tên block với ạ, với khi đặt block thì block luôn luôn ở đơn vị minimet nữa ạ. thank anh

(defun c:qb  (/ blkname ll maxpt minpt mpt ptslst ss ur valslst)
  (cond ((setq ss (ssget "_:L" '((0 . "~VIEWPORT"))))
         (or (setq mpt (getpoint "\nSpecify Base Point: "))
             (and (foreach ent  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                    (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
                    (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                          ptslst (cons (vlax-safearray->list maxpt) ptslst)))
                  (setq ll  (apply 'mapcar (cons 'min ptslst))
                        ur  (apply 'mapcar (cons 'max ptslst))
                        mpt (mapcar '/ (mapcar '+ ll ur) '(2 2 2)))))
         (setq blkname (menucmd "M=$(edtime, $(getvar,date),YYYYDDMO_HHMMSSSS)")
               valslst (mapcar 'getvar (setq lstvars '(CMDECHO INSUNITS))))
         (mapcar 'setvar lstvars '(0 4))
         (vl-cmdf "_.Block" blkname "_non" MPT SS "")
         (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0)
         (prompt (strcat "\nBlock [" blkname "] Was Created."))
         (mapcar 'setvar lstvars valslst))
        ((prompt "\nNothing Selected")))
  (princ))

[Xuân Lộc 11]

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

Haha. Bạn này vui tính quá. Không rảnh về lisp lắm nên bạn không tô màu thì cũng chịu rồi. Xin phép tác giả nha.

Cái này bỏ hết đoạn đó đi. thay bằng (Set_Blkname) thôi bạn. Bỏ vậy hình như bỏ luôn cái kiểm tra tên có chưa. Nhưng chắc không sao đâu. 

cảm ơn bác đã hỗ trợ

[Xuân Lộc 11]

6 giờ trước, NTHAHT đã nói:

(defun c:qb  (/ blkname ll maxpt minpt mpt ptslst ss ur valslst)
  (cond ((setq ss (ssget "_:L" '((0 . "~VIEWPORT"))))
         (or (setq mpt (getpoint "\nSpecify Base Point: "))
             (and (foreach ent  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                    (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
                    (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                          ptslst (cons (vlax-safearray->list maxpt) ptslst)))
                  (setq ll  (apply 'mapcar (cons 'min ptslst))
                        ur  (apply 'mapcar (cons 'max ptslst))
                        mpt (mapcar '/ (mapcar '+ ll ur) '(2 2 2)))))
         (setq blkname (menucmd "M=$(edtime, $(getvar,date),YYYYDDMO_HHMMSSSS)")
               valslst (mapcar 'getvar (setq lstvars '(CMDECHO INSUNITS))))
         (mapcar 'setvar lstvars '(0 4))
         (vl-cmdf "_.Block" blkname "_non" MPT SS "")
         (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0)
         (prompt (strcat "\nBlock [" blkname "] Was Created."))
         (mapcar 'setvar lstvars valslst))
        ((prompt "\nNothing Selected")))
  (princ))

cảm ơn anh đã viết lisp, lisp đúng như ý luôn, chạy ngon lành cành đào, đặt tên vậy chấp cả họ nhà trùng tên block :D

[amateurday 16]

Vào lúc 9/11/2024 tại 14:57, NTHAHT đã nói:

(defun c:qb  (/ blkname ll maxpt minpt mpt ptslst ss ur valslst)
  (cond ((setq ss (ssget "_:L" '((0 . "~VIEWPORT"))))
         (or (setq mpt (getpoint "\nSpecify Base Point: "))
             (and (foreach ent  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                    (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
                    (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                          ptslst (cons (vlax-safearray->list maxpt) ptslst)))
                  (setq ll  (apply 'mapcar (cons 'min ptslst))
                        ur  (apply 'mapcar (cons 'max ptslst))
                        mpt (mapcar '/ (mapcar '+ ll ur) '(2 2 2)))))
         (setq blkname (menucmd "M=$(edtime, $(getvar,date),YYYYDDMO_HHMMSSSS)")
               valslst (mapcar 'getvar (setq lstvars '(CMDECHO INSUNITS))))
         (mapcar 'setvar lstvars '(0 4))
         (vl-cmdf "_.Block" blkname "_non" MPT SS "")
         (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0)
         (prompt (strcat "\nBlock [" blkname "] Was Created."))
         (mapcar 'setvar lstvars valslst))
        ((prompt "\nNothing Selected")))
  (princ))

lisp này rất hay, bạn có thể giải thích tại sao điểm đặt tự động của block có thể tránh được lỗi khi bật full OSNAP không?

Như ảnh, block được tạo sẽ không bị dính vào điểm đầu của line khi bật full OSNAP. Tớ đang cho 2 vị trí này cách nhau = 1.

[Lê Quang Dương 9]

Vào lúc 4/11/2024 tại 20:46, Lê Quang Dương đã nói:

;; Quick Block - Creates Block from selected objects
(defun C:QB (/ SS blkname mpt ptslst minpt maxpt LL UR)
  (if (setq SS (ssget))
    (progn
      (if (or (eq (setq blkname (getstring T "\nBlock Name: ")) "") (/= (tblsearch "block" blkname) nil))
        (Set_blkname)
      )
      (if (not (setq MPT (getpoint "\nSpecify Base Point: ")))
        (progn
          (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
            (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
            (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                  ptslst (cons (vlax-safearray->list maxpt) ptslst)
            )
          )
          (setq LL (apply 'mapcar (cons 'min ptslst))
                UR (apply 'mapcar (cons 'max ptslst))
                MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
          )
        )
      )
      (vl-cmdf "_.Block" blkname "_non" MPT SS "")
      (vl-cmdf "_.Insert" blkname "_non" MPT 1 1 0)
      (prompt (strcat "\nBlock [" blkname "] Was Created."))
    )
    (prompt "\nNothing Selected")
  )
  (princ)
)

(defun Set_BlkName ()
  (setq o-dmzn (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq time (rtos (getvar "CDATE") 2 6)) ; Format YYYYMMDD.HHMMSS
  (setq dtime (substr (rtos (getvar "DATE") 2 9) 13 5))
  (setq blkname (strcat "A" time "." dtime))
  (setvar "dimzin" o-dmzn)
  (princ)
)

Có bác nào chỉnh được lisp này để có thể sử dụng được trong môi trường Block Editor không ạ?

[Xuân Lộc 11]

38 phút trước, Lê Quang Dương đã nói:

Có bác nào chỉnh được lisp này để có thể sử dụng được trong môi trường Block Editor không ạ?

trong môi trường Block Editor có xài đc lệnh block mặc định của cad đâu mà tạo đc, xài lisp của anh @Duong Nhat Duy sẽ tạo đc block trong editor, hoặc có thể hợp nhất 2 lisp vào làm một sẽ tạo đc trong block editor

[Lê Quang Dương 9]

1 giờ} trướ}c, Xuân Lộc đã nói:

trong môi trường Block Editor có xài đc lệnh block mặc định của cad đâu mà tạo đc, xài lisp của anh @Duong Nhat Duy sẽ tạo đc block trong editor, hoặc có thể hợp nhất 2 lisp vào làm một sẽ tạo đc trong block editor

Trong môi trường Block Editor thì Ctrl+C rồi Ctrl+Shift+V vẫn ok