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

Nhờ viết lisp đổi tên 1 nhóm Block cùng tên được chọn

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

Xin chào các anh chị, các bạn trong diễn đàn. Tôi có 1 vấn đề nhờ mọi người trong diễn đàn giúp.

Đó là đổi tên 1 nhóm Block cùng tên được quét chọn mà vẫn giữ lại tên của Block của vùng không được chọn.

Bình thường tôi muốn đổi tên 1 Block như thế thì dùng lisp của lee-mac https://www.lee-mac.com/copyblock.html.

Nhưng Lisp này chỉ đổi được tên 1 Block thôi. Tại Block của nhóm sau có cách bố trí và hình dạng gần giống Block trước (tầng 1, tầng 2, hay phương án 1, phương án 2...).

Bình thường tôi sẽ copy nhóm Block muốn đồi tên sang file cad trống rồi đổi tên. Sau đó copy lại về sửa.

Cách này hơi bất tiện chút nên bạn nào có cách khác tốt hơn chỉ giúp tôi với.

Xin cám ơn!

image.png.5a1dbea54c290469119766ef17ffbf38.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

Bạn thử thêm vòng lặp foreach vào  lisp cụ LeeMac sau khi ssget quét chọn vùng  để coppy và đổi tên từng đối tượng si!

  • Vote tăng 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

Có một cách đơn giản hơn một chút mà ko cần copy qua lại. 

- Dùng lisp của Leemac để đổi tên 1 block trong nhóm Block2

- Dùng thêm 1 lisp Replace Blocks (thay để block đã đổi tên cho các block còn lại của nhóm Block2)

 

:D

  • Vote tăng 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, limfx đã nói:

Bạn thử thêm vòng lặp foreach vào  lisp cụ LeeMac sau khi ssget quét chọn vùng  để coppy và đổi tên từng đối tượng si!

Thank! Ước gì có thể hiểu được lisp của Lee mac. Để tìm hiểu thử foreach xem sao. Chưa học cái đó.

1 giờ trước, conghoa đã nói:

Có một cách đơn giản hơn một chút mà ko cần copy qua lại. 

- Dùng lisp của Leemac để đổi tên 1 block trong nhóm Block2

- Dùng thêm 1 lisp Replace Blocks (thay để block đã đổi tên cho các block còn lại của nhóm Block2)

 

:D

Thank! Chức năng Replace Block trong Express nó thay thế toàn bộ luôn, chứ không thay riêng 1 vùng được. Với lại không hỗ trợ pick chọn Block động nữa.

Nhờ gợi ý thì có kiếm được cái lisp này dùng đỡ.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-group-of-blocks-that-are-selected/m-p/4333482#M313227

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
11 phút trước, conghoa đã nói:

Bên trên mình có ghi rõ là dùng Lisp Replace Block chứ ko phải công cụ có sẵn.

Bạn đọc để tham khảo :)

 

Giai thich lisp Rename Block - Leemac.doc

Cám ơn bạn đã nhiệt tình giúp đỡ.

Giải thích lisp rất rõ ràng. Nhưng sửa được lisp thì phải học hỏi nhiều nữa.

Thay vì sửa chắc sẽ kết hợp 1 lisp chọn Block cùng tên - > Rename Block - Leemac -> Replace Block sẽ dễ hơn

  • 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

Sau một hồi loay hoay hỏi hỏi đáp đáp với cái trí tuệ nhân tạo thì ra được cái đoạn code này để kết hợp 2 lisp với nhau =))

 

Nội dung lisp1

Nội dung lisp2

Chèn thêm đoạn này xuống dưới.

 

(defun c:kethop ()
  (progn
    (c:rb)
    (c:BRE)
  )
)

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
Vào lúc 6/6/2024 tại 16:36, conghoa đã nói:

Sau một hồi loay hoay hỏi hỏi đáp đáp với cái trí tuệ nhân tạo thì ra được cái đoạn code này để kết hợp 2 lisp với nhau =))

 

Nội dung lisp1

Nội dung lisp2

Chèn thêm đoạn này xuống dưới.

 

(defun c:kethop ()
  (progn
    (c:rb)
    (c:BRE)
  )
)

Sau một hồi mày mò trộn lisp chọn Block cùng tên với lisp thay thế Block thì cũng đã làm được việc rồi.

Nhưng thay thế Block bị một hạn chế so với Rename là Block có ATT. các ATT khi thay thế bị đưa về mạc định hết.

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
37 phút trước, ZIS3 đã nói:

https://www.cadstudio.cz/en/download.asp?file=RIblock

Bạn dùng thử cái Lisp Riblock miễn phí này

Theo quảng cáo là hỗ trợ thay (replace) cả attribute, dynamic block.

Cảm ơn bạn. Lisp này cũng ổn. Có lẽ tại ATT là field nên cũng khó.

Thấy lisp xch dễ dùng hơn.

Mà tìm lisp đổi tên Block được chọn thì toàn đi theo hướng Replace thôi. Dù không hoàn hảo như ý nhưng cũng hỗ trợ được nhiều rồi

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-only-selected-blocks-with-a-different-one-lisp/td-p/6933210

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

Như thông tin bạn cung cấp từ post đầu tiên, tôi hình dung là bạn có nhiều block gần giống nhau; chỉ khác nhau ở 1 hoặc 2 tham số.

1 bộ tổ hợp 2 tham số khác nhau sẽ phải sinh ra 1 block khác. Ví dụ như: Biển báo cấm dành cho đường tốc độ 60 km/h;  biển báo nguy hiểm dành cho đường tốc độ 80 km/h.  "Cấm" và "Nguy hiểm" là 2 visibility states khác nhau (Tròn và tam giác);  60 km/h và 80km/h sẽ tương ứng với 2 giá trị dynamic property (ở đây là tham số scale) khác nhau.

Nếu đúng vậy, thì tôi nghĩ bạn nên nghiên cứu làm 1 dynamic block có nhiều Visibility state; thậm chí là Visibility states kết hợp với nhiều Lookup table như mấy cái ví dụ này:

 

 

 

  • 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
4 giờ trước, ZIS3 đã nói:

Như thông tin bạn cung cấp từ post đầu tiên, tôi hình dung là bạn có nhiều block gần giống nhau; chỉ khác nhau ở 1 hoặc 2 tham số.

1 bộ tổ hợp 2 tham số khác nhau sẽ phải sinh ra 1 block khác. Ví dụ như: Biển báo cấm dành cho đường tốc độ 60 km/h; 

 

 

Thank bạn! Mình cũng tạo Block giống như bạn nói nhưng có quá nhiều trường hợp nên không thể làm tất cả vào 1 Block được.

Ví dụ 1: bố trí trụ nhà xưởng 1 là I 500x200, xưởng 2 giống xưởng 1 nhưng đổi thành H300... Ở đây dùng 2 Block table là H và I.

Ví dụ 2: sàn tầng 1 đến 4 đỡ bằng I200x100 khoảng cách tim là 600. Sàn tầng 5 đỡ bằng thép hộp 60x120 khoảng cách cũng giống các tầng còn lại.

Ví dụ 3: trục 1 dùng 3 phốt 130x110x10. Phương án 2, trục 1 đổi thành phốt 140x110x10 vậy nên đổi Block phốt và mặt bích.

Nói chung là đổi Block nhưng không đổi cách bố trí.

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, vietduc147258 đã nói:

Cảm ơn bạn. Lisp này cũng ổn. Có lẽ tại ATT là field nên cũng khó.

Thấy lisp xch dễ dùng hơn.

Mà tìm lisp đổi tên Block được chọn thì toàn đi theo hướng Replace thôi. Dù không hoàn hảo như ý nhưng cũng hỗ trợ được nhiều rồi

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-only-selected-blocks-with-a-different-one-lisp/td-p/6933210

(Quay lại hướng Replace block bàn thêm)

Cái Field code trong attribute của bạn nó trỏ đến Object ID của chính bản thân cái block instance (block reference) chứa attribute đó phải không?

Ví dụ:   Cái block reference có điểm chèn là (200,400) và cái attribute dùng field code để hiển thị chính cái điểm chèn đó.

Mỗi lần thay block chả nhẽ lại đi hì hục sửa lại field code ?
*
Cái block của bạn có attribute, có dynamic properties, attribute có cả field code.  Chỉ còn thiếu mỗi bật annotative = Yes nữa là max độ khó.

Bạn có thể thử cái tool này (nhảy cóc đến 4:40):

 

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
14 giờ trước, ZIS3 đã nói:

(Quay lại hướng Replace block bàn thêm)

Cái Field code trong attribute của bạn nó trỏ đến Object ID của chính bản thân cái block instance (block reference) chứa attribute đó phải không?

Ví dụ:   Cái block reference có điểm chèn là (200,400) và cái attribute dùng field code để hiển thị chính cái điểm chèn đó.

Mỗi lần thay block chả nhẽ lại đi hì hục sửa lại field code ?
*
Cái block của bạn có attribute, có dynamic properties, attribute có cả field code.  Chỉ còn thiếu mỗi bật annotative = Yes nữa là max độ khó.

Bạn có thể thử cái tool này (nhảy cóc đến 4:40):

 

Cảm ơn bạn nhiệt tình giúp đỡ. Không áp dụng trong trường hợp này nhưng lại học hỏi thêm được nhiều thứ.

Replace block trong công cụ Express Tool (đang dùng Autocad 2018) tồn tại 2 nhược điểm sau:

1. Không hỗ trợ Dynamic Block

2. Thay thế toàn bộ Block trong bản vẽ chứ không phải thay thế vùng chọn.

Tool trong Video khắc phục được nhưng tiếc là lỗi chưa down về thử được.

Lúc trước cứ tìm hướng thêm vòng lặp chỗ Rename Block mà quên mất chỉ Rename được Block đầu tiên thôi, đến cái thứ 2 thì sẽ bị trùng tên, do tên thứ nhất đã tồn tại. Vậy nên sẽ lỗi.

Giờ chấp nhận dùng Replace thôi. Thực ra những Block cần Replace có ATT không nhiều lắm, hoặc ATT không quan trọng có thể bỏ luôn.

Còn trường hợp phức tạp hơn sẽ copy sang bản vẽ khác rename -> sửa -> copy ngược lại

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

Sẵn đây gửi lisp mình sửa để bạn nào cần thì tham khảo

Cái này góp 2 lisp  trên diễn đàn mình với forum autodesk lại. Nhìn cấu trúc lisp có vẻ lủng củng lắm. nhưng trình độ có hạn nên để vậy thôi.

lệnh BRS nhé

 

 

;; Chon Block cung ten
;; https://www.cadviet.com/forum/index.php?app=forums&module=forums&controller=topic&id=194319

(defun LM:SelectIf ( msg pred func keyw / sel )
(setq pred (eval pred))
(while
(progn
(setvar 'ERRNO 0)
(if keyw (apply 'initget keyw))
(setq sel (func msg))
(cond
((= 7 (getvar 'ERRNO)) (princ "\nMissed, Try again."))
((eq 'STR (type sel)) nil)
((vl-consp sel) (if (and pred (not (pred sel))) (princ "\nInvalid Object Selected."))))))
sel)
;;;;;;;;;;;;;;;
(defun List-to-ss (lst / ss)
(setq ss (ssadd))
(foreach item lst
 (or (= (type item ) 'Ename)
  (setq item (vlax-vla-object->ename  item)))
 (setq ss (ssadd item ss))
)
ss
)
;;;;;;;;;;;;;;;;;
(defun laytenblock (ent / blk_name)
(if (not (setq blk_name (vlax-get (vlax-Ename->Vla-Object ent) 'Effectivename))) 
(setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))
)
blk_name
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ss->lst (ss / lst)
(if ss
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)
)


;; Lisp ReplaceBlock
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-replace-block-with-another-block/td-p/8094625

(vl-load-com)

(defun brerr (errmsg)
  (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
    (princ (strcat "\nError: " errmsg))
  ); if
  (command "_.undo" "_end")
  (setvar 'cmdecho cmde)
  (princ)
); defun -- brerr

(defun *ev (ltr); evaluate what's in variable name with letter
  (eval (read (strcat "*br" ltr "name")))
); defun - *ev

(defun brsetup (this other / temp)
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "_.undo" "_begin")
  (while
    (or
      (not temp); none yet [first time through (while) loop]
      (and (not (*ev this)) (not (*ev other)) (= temp (getvar 'insname) ""))
        ; no this-command or other-command or Insert defaults yet, on User Enter
      (and ; availability check
        (/= temp ""); User typed something other than Enter, but
        (not (tblsearch "block" temp)); no such Block in drawing, and
        (not (findfile (strcat temp ".dwg"))); no such drawing in Search paths
      ); and
    ); or
 (setq bltt (car (LM:SelectIf "\nChon Block  thay the (Block moi):" (lambda (x) (eq "INSERT" (cdr (assoc 0 (entget (car x))))) ) entsel nil)))
 (setq temp (laytenblock bltt))
  ); while
  (set (read (strcat "*br" this "name"))
    (cond
      ((/= temp "") temp); User typed something
      ((*ev this)); default for this command, if any
      ((*ev other)); default for other command, if any
      ((getvar 'insname)); Enter on first use with Insert's default
    ); cond
  ); set
  (if (not (tblsearch "block" (*ev this))); external drawing, not yet Block in current drawing
    (command "_.insert" (*ev this) nil); bring in definition, don't finish Inserting
  ); if
); defun -- brsetup


(defun C:BRS ; = Block Replace: Selected
;;  To Replace User-selected Block(s) of any name(s) with User-specified Block name.
;;  [Notice of selected Block(s) on locked Layers is within selection; not listed at end
;;    as in BRA;  off or frozen Layers are irrelevant with User selection.]
;;  Rejects Xrefs, but does replace any Windows Metafile objects among selection.
 ; (/ *error* cmde ss repl notrepl ent)
 ()
  (setq *error* brerr)
  (brsetup "s" "a")

 
  (prompt (strcat "\nTo replace Block insertion(s) with " *brsname ","))
  
 (setq ent1 (car (LM:SelectIf "\nChon Block muon thay the:" (lambda (x) (eq "INSERT" (cdr (assoc 0 (entget (car x))))) ) entsel nil)))
(setq tenblmau (laytenblock ent1))
(princ "\nChon vung can thay the Block:")
(setq ss (ss->lst (ssget (list (cons 0 "INSERT")))))
(setq ssblc (List-to-ss (vl-remove-if-not '(lambda (x) (= (laytenblock x) tenblmau)) ss)))
(setq 	ss ssblc)
  (setq
;    ss (ssget ":L" '((0 . "INSERT"))); Blocks/Xrefs/Minserts/WMFs on unlocked Layers

    repl (sslength ss) notrepl 0
  ); setq
  (repeat repl
    (setq ent (ssname ss 0))
    (if (not (assoc 1 (tblsearch "block" (cdr (assoc 2 (entget ent)))))); not Xref
      (vla-put-Name (vlax-ename->vla-object ent) *brsname); then
      (setq notrepl (1+ notrepl) repl (1- repl)); else
    ); if
    (ssdel ent ss)
  ); repeat
  (prompt (strcat "\n" (itoa repl) " Block(s) replaced with " *brsname "."))
  (if (> notrepl 0) (prompt (strcat "\n" (itoa notrepl) " Xref(s) not replaced.")))
  (command "_.undo" "_end")
  (setvar 'cmdecho cmde)
  (princ)
); defun -- BRS

 

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

Trong này có

Lệnh unib để đổi tên 1 insert dạng Block1 thành Block1-Copy, các insert Block1 còn lại không thay đổi.

Lệnh mabl để quét chuyển đổi các insert theo mẫu (Match Block) dạng như lệnh MATCHPROP. Bạn chỉ cần chèn 1 khối mong muốn rồi quét chuyển các khối còn lại thành nó.

;;-------------------------- c:MakeUnikeBlk-----------------------------;;
;; José L. García G - 17/04/17                                          ;;
;;                                                                      ;;
;; This command uses the function: LM:CopyBlockDefinition of Lee Mac    ;;
;;----------------------------------------------------------------------;;
(defun c:unib ( / ssTmp NameBlk NewNameBlk GetNameUnique )
	 (defun GetNameUnique (str / ret)
	  (while (tblsearch "BLOCK" (setq ret (strcat str "-" (vl-filename-base (vl-filename-mktemp "Copy"))))))
	  ret
	 )
 ;;---------------------- MAIN ----------------------------
 (prompt "\nSelect Insert Block: ")
 (cond
  ((not (and (setq ssTmp (ssget "_:S:E" '((0 . "INSERT"))))
	     (setq InsBlk (ssname ssTmp 0))))
   (prompt "\nNo block selected.")
  )
  (T
   (setq InsBlk (vlax-ename->vla-object InsBlk))
   (setq NameBlk (vlax-get-property
		  InsBlk
		  (if (vlax-property-available-p InsBlk 'EffectiveName)
		   'EffectiveName 'Name)))

   (setq NewNameBlk (GetNameUnique NameBlk))
   ;;(print NameBlk)(princ " - ")(princ NewNameBlk)(princ)
   (cond
    ((LM:CopyBlockDefinition NameBlk NewNameBlk)
     (vla-put-name InsBlk NewNameBlk)
     (prompt (strcat "\nMake Unique Block: [" NewNameBlk "]."))
    )
   )
  )
 )
 (princ)
)
    
(defun c:mabl ()
  (setq ob (vlax-ename->vla-object (car (entsel)))
	ss (ssget '((0 . "INSERT")))
	ss (ss->ent ss)
	)
  (setq NameBlk (vlax-get-property
		  ob
		  (if (vlax-property-available-p ob 'EffectiveName)
		   'EffectiveName 'Name)))
(foreach ent ss
  (vla-put-name (vlax-ename->vla-object ent) NameBlk))
  )
	      
                

;; Copy Block Definition  -  Lee Mac
;; Duplicates a block definition, with the copied definition assigned the name provided.
;; blk - [str] name of block definition to be duplicated
;; new - [str] name to be assigned to copied block definition
;; Returns the copied VLA Block Definition Object, else nil
(defun LM:CopyBlockDefinition ( blk new / abc app dbc dbx def doc rtn vrs )
    (setq dbx
        (vl-catch-all-apply 'vla-getinterfaceobject
            (list (setq app (vlax-get-acad-object))
                (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                    "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
                )
            )
        )
    )
    (cond
        (   (or (null dbx) (vl-catch-all-error-p dbx))
            (prompt "\nUnable to interface with ObjectDBX.")
        )
        (   (and
                (setq doc (vla-get-activedocument app)
                      abc (vla-get-blocks doc)
                      dbc (vla-get-blocks dbx)
                      def (LM:getitem abc blk)
                )
                (not (LM:getitem abc new))
            )
            (vlax-invoke doc 'copyobjects (list def) dbc)
            (vla-put-name (setq def (LM:getitem dbc  blk)) new)
            (vlax-invoke dbx 'copyobjects (list def) abc)
            (setq rtn (LM:getitem abc new))
        )
    )
    (if (= 'vla-object (type dbx))
        (vlax-release-object dbx)
    )
    rtn
)
 
;; VLA-Collection: Get Item  -  Lee Mac
;; Retrieves the item with index 'idx' if present in the supplied collection
;; col - [vla]     VLA Collection Object
;; idx - [str/int] Index of the item to be retrieved
(defun LM:getitem ( col idx / obj )
    (if (not (vl-catch-all-error-p (setq obj (vl-catch-all-apply 'vla-item (list col idx)))))
        obj
    )
)

(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

Cảm ơn anh @cuongtk2

Lisp trên hoạt động khá tốt nhưng vẫn còn 2 nhược điểm.

1. Đối với Block động, Block Table thì khi thay Block các thông số kích thước trong Custom (Các thuộc tính) sẽ thành mạc định hết. Cái này có thể khắc phục bằng lisp Copy Text, Att, Dynamic.lsp của @Duong Nhat Duy.

2. Thay thế tất cả các Block được chọn chứ không riêng gì Block cùng tên với nhau.

Tuy nhiên Lisp cũng đáp ứng khá tốt rồi. Cũng không nên đòi hòi nhiều.

Lisp trên còn thiếu đoạn ss-ent. đăng lại cho những bạn nào cần.

;;-------------------------- c:MakeUnikeBlk-----------------------------;;
;; José L. García G - 17/04/17                                          ;;
;;                                                                      ;;
;; This command uses the function: LM:CopyBlockDefinition of Lee Mac    ;;
;;----------------------------------------------------------------------;;
(defun c:unib ( / ssTmp NameBlk NewNameBlk GetNameUnique )
	 (defun GetNameUnique (str / ret)
	  (while (tblsearch "BLOCK" (setq ret (strcat str "-" (vl-filename-base (vl-filename-mktemp "Copy"))))))
	  ret
	 )
 ;;---------------------- MAIN ----------------------------
 (prompt "\nSelect Insert Block: ")
 (cond
  ((not (and (setq ssTmp (ssget "_:S:E" '((0 . "INSERT"))))
	     (setq InsBlk (ssname ssTmp 0))))
   (prompt "\nNo block selected.")
  )
  (T
   (setq InsBlk (vlax-ename->vla-object InsBlk))
   (setq NameBlk (vlax-get-property
		  InsBlk
		  (if (vlax-property-available-p InsBlk 'EffectiveName)
		   'EffectiveName 'Name)))

   (setq NewNameBlk (GetNameUnique NameBlk))
   ;;(print NameBlk)(princ " - ")(princ NewNameBlk)(princ)
   (cond
    ((LM:CopyBlockDefinition NameBlk NewNameBlk)
     (vla-put-name InsBlk NewNameBlk)
     (prompt (strcat "\nMake Unique Block: [" NewNameBlk "]."))
    )
   )
  )
 )
 (princ)
)
    
(defun c:mabl ()
  (setq ob (vlax-ename->vla-object (car (entsel)))
	ss (ssget '((0 . "INSERT")))
	ss (LM:ss->ent ss)
	)
  (setq NameBlk (vlax-get-property
		  ob
		  (if (vlax-property-available-p ob 'EffectiveName)
		   'EffectiveName 'Name)))
(foreach ent ss
  (vla-put-name (vlax-ename->vla-object ent) NameBlk))
  )
	      
                

;; Copy Block Definition  -  Lee Mac
;; Duplicates a block definition, with the copied definition assigned the name provided.
;; blk - [str] name of block definition to be duplicated
;; new - [str] name to be assigned to copied block definition
;; Returns the copied VLA Block Definition Object, else nil
(defun LM:CopyBlockDefinition ( blk new / abc app dbc dbx def doc rtn vrs )
    (setq dbx
        (vl-catch-all-apply 'vla-getinterfaceobject
            (list (setq app (vlax-get-acad-object))
                (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                    "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
                )
            )
        )
    )
    (cond
        (   (or (null dbx) (vl-catch-all-error-p dbx))
            (prompt "\nUnable to interface with ObjectDBX.")
        )
        (   (and
                (setq doc (vla-get-activedocument app)
                      abc (vla-get-blocks doc)
                      dbc (vla-get-blocks dbx)
                      def (LM:getitem abc blk)
                )
                (not (LM:getitem abc new))
            )
            (vlax-invoke doc 'copyobjects (list def) dbc)
            (vla-put-name (setq def (LM:getitem dbc  blk)) new)
            (vlax-invoke dbx 'copyobjects (list def) abc)
            (setq rtn (LM:getitem abc new))
        )
    )
    (if (= 'vla-object (type dbx))
        (vlax-release-object dbx)
    )
    rtn
)
 
;; VLA-Collection: Get Item  -  Lee Mac
;; Retrieves the item with index 'idx' if present in the supplied collection
;; col - [vla]     VLA Collection Object
;; idx - [str/int] Index of the item to be retrieved
(defun LM:getitem ( col idx / obj )
    (if (not (vl-catch-all-error-p (setq obj (vl-catch-all-apply 'vla-item (list col idx)))))
        obj
    )
)

(princ)

(defun LM:ss->ent ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (ssname ss (setq i (1- i))) l))
        )
    )
)

 

  • 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

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  

×