Đến nội dung


Hình ảnh
- - - - -

Code lisp về thao tác với block trong bản vẽ


  • Please log in to reply
5 replies to this topic

#1 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 13 March 2009 - 12:27 AM

Có một thư viện thao tác block khá hay, mọi người có thể tham khảo khi viết chương trình thao tác với block.

Thư viện này sẽ làm các công việc:
Erases all blocks with a specific name
Xóa các block với tên cho trước
Test if specified named block exist
Kiểm tra xem block đã tồn tại chưa
Rename block
đổi tên block
List of all block names
liệt kê tên các block
List of all xref names
liệt kê tên các xref
Returns a list with references to a given block
trả về danh sách các trỏ đến block đã cho
Returns a list containing every reference to a given block
trả về danh sách các các liên kết trong block đã cho
Returns a list containing the entity names of block definitions that reference a given block
trả về danh sách chứa tên các đối tượng trong bảng định nghĩa block trỏ tới block đã cho
Deletes the specified subentity from its block definition
Xóa các đối tượng con được chỉ định trong bảng định nghĩa của block đã cho
Adds the specified item to a given block definition
Thêm các đối tượng được chỉ định vào bảng định nghĩa của block đã cho
Convert a selection set to an ActiveX array
Chuyển đổi tập chọn thành mảng ActiveX
Find the value of specified block and attribute
Tìm giá trị của block và attribute được chỉ định
Find a block with a specified name, attribute and value
Tìm một block với tên, attribute như giá trị đã cho
List of all blocks with specified name and attribute in order of y-coordinate, bottom to up
Liệt kê tất cả các tên được chỉ định và thuộc tính trong thứ tự tăng dần của tọa độ Y
Change attribute value in specified block with specified attribute value
Thay đổi giá trị attribute trong block được chỉ định sang một giá trị khác
Change attribute height
Đổi chiều cao Attribute
List the insertion point and reference of a block in active layout sort them by y-value
Liệt kê các điểm chèn và reference của một block trong layout hiện tại, sắp xếp theo giá trị tọa độ y
Changes the insertion point of a tag
Thay đổi điềm chèn của một tag (là attribute trong bảng định nghĩa block)
Changes attributes on all block references matching specified name
Thay đổi attribute trong tất cả các block mà khớp với tên đã cho
Change attribute width
Đổi bề rộng cảu attribute


;;; By Jimmy Bergmark
;;; Copyright © 1997-2006 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;;
;;; Updated: 2003-02-24
;;;

;;; (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

;;; Erases all blocks named "revtext2"
;;; (ax:EraseBlock doc "revtext2")
(defun ax:EraseBlock (doc bn / layout i)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(vla-Delete i)
)
)
)
)

;;; Test if block named "revtext2" exist
;;; (ax:ExistBlock doc "revtext2")
(defun ax:ExistBlock (doc bn / layout i exist)
(setq exist nil)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(setq exist T)
)
)
)
exist
)

;;; Rename block from "revtext" to "revtext1"
;;; (ax:RenameBlock doc "revtext" "revtext1")
(defun ax:RenameBlock (doc bn nn / layout i)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(vla-put-name i nn)
)
)
)
)

;;; a list of all block names
;;; return example ("*D5" "A$C263E5435" "b2" "b1")
(defun ax:blocks (/ b bn tl)
(vlax-for b (vla-get-blocks
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (= (vla-get-islayout B ) :vlax-false)
(setq tl (cons (vla-get-name B ) tl))
)
)
(reverse tl)
)

;;; a list of all xref names
;;; return example ("xref1" "x2")
(defun ax:xrefs (/ b bn tl)
(vlax-for b (vla-get-blocks
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (= (vla-get-isxref B ) :vlax-true)
(setq tl (cons (vla-get-name B ) tl))
)
)
(reverse tl)
)

;;; Returns a list with references to a given block
;;; (blockrefs )
;;; example: (blockrefs "b1")
;;; return: ( )
;;; tip: if return is nil it's not inserted
(defun blockrefs (bn / lst ed)
(if (setq ed (tblobjname "block" bn))
(setq
lst (entget
(cdr (assoc 330 (entget ed)))
)
)
)
(apply
'append
(mapcar '(lambda (x)
(list (cdr x))
)
(cdr (reverse (cdr (member (assoc 102 lst) lst))))
)
)
)

;;; Returns a list containing every reference to a given block
;;; Arguments: a string identifying the block to search for
(defun listblockrefs (blkName / lst)
(setq lst (entget
(cdr (assoc 330 (entget (tblobjname "block" blkName))))
)
)
(apply
'append
(mapcar '(lambda (x)
(if (entget (cdr x))
(list (cdr x))
)
)
(cdr (reverse (cdr (member (assoc 102 lst) lst))))
)
)
)

;;; Returns a list containing the entity names
;;; of block definitions that reference a given block
;;; Arguments: a string identifying the block to search for
(defun ax:GetParentBlocks (blkName / doc)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(apply
'append
(mapcar '(lambda (x)
(if (= :vlax-false
(vla-get-IsLayout
(vla-ObjectIdToObject
doc
(vla-get-OwnerId (vlax-ename->vla-object x))
)
)
)
(list x)
)
)
(listblockrefs blkName)
)
)
)

;;; Deletes the specified subentity from its block definition
;;; Arguments: the entity name of an item within a block reference
;;; Returns: the remaining item count of the block definition
;;; The drawing must be regenerated for the change to become visible
(defun ax:DeleteObjectFromBlock (ent / doc blk)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
ent (vlax-ename->vla-object ent)
blk (vla-ObjectIdToObject doc (vla-get-OwnerID ent))
)
(vla-Delete ent)
(vla-get-Count blk)
)

;;; Adds the specified item to a given block definition
;;; Arguments: the entity name of a block reference
;;; a selection set containing the objects to add
;;; Returns: nil
;;; The drawing must be regenerated for the change to become visible
(defun ax:AddObjectsToBlock (blk ss / doc blkref blkdef inspt refpt)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
blkref (vlax-ename->vla-object blk)
blkdef (vla-Item (vla-get-Blocks doc) (vla-get-Name blkref))
inspt (vlax-variant-value (vla-get-InsertionPoint blkref))
ssarray (selectionset->array ss)
refpt (vlax-3d-point '(0 0 0))
)
(foreach ent (vlax-safearray->list ssarray)
(vla-Move ent inspt refpt)
)
(vla-CopyObjects doc ssarray blkdef)
(foreach ent (vlax-safearray->list ssarray)
(vla-Delete ent)
)
(princ)
)

;;; Utility routine to convert a selection set to an ActiveX array
(defun selectionset->array (ss / c r)
(vl-load-com)
(setq c -1)
(repeat (sslength ss)
(setq r (cons (ssname ss (setq c (1+ c))) r))
)
(setq r (reverse r))
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbObject
(cons 0 (1- (length r)))
)
(mapcar 'vlax-ename->vla-object r)
)
)

;;; (ax:GetTagTextString doc "sheet-text" "client-drw")
(defun ax:GetTagTextString (doc bn tagname / layout i atts tag str)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(setq str (vla-get-TextString tag))
)
)
)
)
)
)
str
)

;;; (ax:FindBlockTagValue (vla-get-activedocument
;;; (vlax-get-acad-object)) "blockname" "tagname" "tagvalue")
(defun ax:FindBlockTagValue
(doc bn tagname value / layout i atts tag sset c)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(progn
(foreach tag (vlax-safearray->list atts)
(if (and
(= (strcase tagname)
(strcase (vla-get-TagString tag))
)
(= value (vla-get-TextString tag))
)
(progn
(if (not sset)
(setq sset (ssadd (vlax-vla-object->ename i)))
(ssadd (vlax-vla-object->ename i) sset)
)
)
)
)
)
)
)
)
)
(sssetfirst nil sset)
)

;;; list of all "REV-NO" in block "revtext1" in order of y-coordinate, bottom to up
;;; (ax:GetManyTags "revtext1" "REV-NO")
(defun ax:GetManyTags (bn tag / ax lst)
(foreach x (ax:ListBlockIns doc bn)
(setq lst (cons (ax:GetTagTextStringByRef (cadddr x) tag) lst))
)
(reverse lst)
)

;;; list of all "REV-NO" in block "revtext2" in order of y-coordinate, bottom to up
;;; (ax:SetManyTags "revtext2" "revtext1" "REV-NO" "REV-NO")
(defun ax:SetManyTags (bn-to bn-from tag-to tag-from / ax lst i)
(setq lst (ax:GetManyTags bn-from tag-from))
(setq i 0)
(foreach x (ax:ListBlockIns doc bn-to)
(ax:PutTagTextStringByRef (cadddr x) tag-to (nth i lst))
(setq i (1+ i))
)
)

;;; (ax:GetTagTextStringByRef # "REV-NO")
(defun ax:GetTagTextStringByRef (br tagname / atts tag str)
(if (and
(= (vla-get-hasattributes br) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes br)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(setq str (vla-get-TextString tag))
)
)
)
str
)

;;; (ax:PutTagTextString doc "sheet-text" "client-drw" "new value")
(defun ax:PutTagTextString (doc bn tagname textstring / layout i atts tag)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(vla-put-TextString tag textstring)
)
)
(vla-update i)
)
)
)
)
)

;;; (ax:PutTagTextStringByRef #
;;; "REV-NO" "new value")
(defun ax:PutTagTextStringByRef (br tagname textstring / atts tag)
(if (and
(= (vla-get-hasattributes br) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes br)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(vla-put-TextString tag textstring)
)
)
(vla-update br)
)
)

;;; (ax:ChangeTagHeight )
;;; (ax:ChangeTagHeight doc "sheet-text" "client-drw" 0.97)
(defun ax:ChangeTagHeight (doc bn tagname tagheight / layout i atts tag)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(vla-put-height tag tagheight)
)
)
(vla-update i)
)
)
)
)
)

;;; List the insertion point and reference of a block in active layout
;;; sort them by y-value
;;; (ax:ListBlockIns doc "revtext1")
;;; return value example:
;;; ((341.385 29.2937 0.0 #)
;;; (341.385 34.2937 0.0 #)
;;; (341.385 39.2937 0.0 #))
(defun ax:ListBlockIns (doc bn / layout i pl)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(setq pl
(cons
(append (safearray-value
(vlax-variant-value (vla-get-InsertionPoint i))
)
(list i)
)
pl
)
)
)
)
)
; sort by y-value
(vl-sort pl
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2)) ) ) )
)

;;; Changes the insertion point of a tag
;;; (ax:ChangeTagIns doc "sheet-text" "a3-scale" '(703.4722 17.8350 0))
(defun ax:ChangeTagIns (doc bn tagname ins / layout i atts tag)
(defun list->variantArray (ptsList / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (length ptsList) 1))
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(vla-put-InsertionPoint tag (list->variantArray ins))
)
)
(vla-update i)
)
)
)
)
)

;;; Changes attributes on all block references matching
;;; (ChangeAttributes (list '( . ) ...))
;;; (ChangeAttributes (list "testblock" '("TESTTAG2" . "item1") '("NEWTAG" . "tagvalue")))
(defun ChangeAttributes (lst / sset item atts ename i)
(setq i 0)
(setq sset (ssget "X" (list '(0 . "INSERT") (cons 2 (car lst)))))
(if sset
(repeat (sslength sset)
(setq ename (ssname sset i))
(setq i (+ 1 i))
(if (safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes (vlax-ename->vla-object ename))
)
)
)
(progn
(foreach item (cdr lst)
(mapcar
'(lambda (x)
(if
(= (strcase (car item))
(strcase (vla-get-tagstring x))
)
(vla-put-textstring x (cdr item))
)
)
(vlax-safearray->list atts)
)
)
(vla-update (vlax-ename->vla-object ename))
)
)
)
)
)

;;; (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
;;; (ax:ChangeTagWidth )
;;; (ax:ChangeTagWidth doc "panel1" "drw-no" 0.97)
(defun ax:ChangeTagWidth (doc bn tagname tagwidth / layout i atts tag)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(vla-put-scalefactor tag tagwidth)
)
)
(vla-update i)
)
)
)
)
)

  • 1

#2 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 18 July 2009 - 09:58 AM

Lisp trên rất hay, nhưng em không sử dụng được. Xin hỏi bác Hoành và mọi người: lệnh dùng cho lisp này là như thế nào?
Có phải dòng chữ sau "defun ax", ví dụ: "EraseBlock".
Sau khi em apload lisp và gõ "Eraseblock" thì nhận được thông báo: Unknown command "ERASEBLOCK". Press F1 for help.
Còn khi gõ "Renameblock" thì nhận được thông báo: ; error: too few arguments
Rất mong nhận được giải đáp, thanks!
  • 0
http://khuyen.space

#3 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 20 July 2009 - 07:51 AM

Lisp trên rất hay, nhưng em không sử dụng được. Xin hỏi bác Hoành và mọi người: lệnh dùng cho lisp này là như thế nào?
Có phải dòng chữ sau "defun ax", ví dụ: "EraseBlock".
Sau khi em apload lisp và gõ "Eraseblock" thì nhận được thông báo: Unknown command "ERASEBLOCK". Press F1 for help.
Còn khi gõ "Renameblock" thì nhận được thông báo: ; error: too few arguments
Rất mong nhận được giải đáp, thanks!

Đây là điểm mà Tue_NV còn thắc mắc.
Mình chưa rõ : (defun ax: .... lắm
Mong bác Hoành, bác ssg và các bác trên diễn đàn giải thích hộ
Xin chân thành cảm ơn rất nhiều
  • 0

#4 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 20 July 2009 - 11:02 AM

Đây là điểm mà Tue_NV còn thắc mắc.
Mình chưa rõ : (defun ax: .... lắm
Mong bác Hoành, bác ssg và các bác trên diễn đàn giải thích hộ
Xin chân thành cảm ơn rất nhiều

Chào Tue_NV
ax: có thể chỉ là cách phân lọai các hàm khác nhau khi đặt tên.
vd : Tue_NV có thể đặt tên 1 hàm là Tue_NV:chonTxt bằng cách (defun Tue_NV:chonTxt() .... )

Lisp trên rất hay, nhưng em không sử dụng được. Xin hỏi bác Hoành và mọi người: lệnh dùng cho lisp này là như thế nào?
Có phải dòng chữ sau "defun ax", ví dụ: "EraseBlock".
Sau khi em apload lisp và gõ "Eraseblock" thì nhận được thông báo: Unknown command "ERASEBLOCK". Press F1 for help.
Còn khi gõ "Renameblock" thì nhận được thông báo: ; error: too few arguments
Rất mong nhận được giải đáp, thanks!

minh họa việc sử dụng hàm ax:EraseBlock

;;; Erases all blocks named "revtext2"
;;; (ax:EraseBlock doc "revtext2")
(defun ax:EraseBlock (doc bn / layout i)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(vla-Delete i)
)
)
)
)

(defun c:test (/ doc blmau ten)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
Blmau (car(entsel "\n Pick chon Block mau :"))
ten (cdr(assoc 2 (entget Blmau))))
;xoa tat ca cac block co block name = ten
(ax:EraseBlock doc ten)
)

  • 2

#5 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 20 July 2009 - 11:10 AM

Đây là điểm mà Tue_NV còn thắc mắc.
Mình chưa rõ : (defun ax: .... lắm
Mong bác Hoành, bác ssg và các bác trên diễn đàn giải thích hộ
Xin chân thành cảm ơn rất nhiều

Theo em ax:EraseBlock đơn thuần chỉ là 1 hàm con có tên như thế. Tức là muốn dùng hàm này thì đánh lệnh (ax:EraseBlock) thôi. Tiền tố ax: tác giả dùng để phân biệt với các nhóm hàm con khác
  • 2

#6 Polyline

Polyline

    biết lệnh mirror

  • Members
  • PipPipPip
  • 159 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 29 September 2013 - 02:42 PM

Các hàm con này có làm việc bên trong Block không bác, ví dụ như khi ra lệnh xóa BlockA thì nó có xóa BlockA ra khỏi các Block khác luôn không?
  • 0