[转贴]：添加实体到指定块

lsjjm · 发表于 2003-6-26 09:30:53

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

添加实体到指定块

(vl-load-com)
;; Bill Kramer - PointA Wizards Lab Scroll
;; See related article for details about what is going on in this
;; code! Function utilities are provided for adding and removing
;; specific entity objects from block definitions.
;; AppendBlock - Given a block name, an entity name in model space,
;; and a base point (normally location of a given insert of the block)
;; this routine will append the entity to the block definition.
;; Returns object reference when successful for new item inserted into
;; the block definition. Returns nil if the entity type is not supported.
(defun AppendBlock (BN ; block name
EN ; entity name to add
BP ; base point of insert occurance
/
acadObj ;object reference variable
Etype ;entity type string
)
(setq acadObj (Get_Block_Ref_Obj BN) ;get block reference object
EN (entget EN) ;entity specifics
EType (cdr (assoc 0 EN)) ;entity descriptive name
)
;; Add... method used to add objects to the block collection object.
;; is specific for each type of entity you wish to support.
(cond
((= eType "LINE") ; Add a line object to the block definition
(vla-addline
acadObj
(vlax-3d-point (mapcar '- (cdr (assoc 10 EN)) BP))
(vlax-3d-point (mapcar '- (cdr (assoc 11 EN)) BP))
)
)
((= eType "CIRCLE") ; Add a circle object to the block definition
(vla-addcircle
acadObj
(vlax-3d-point (mapcar '- (cdr (assoc 10 EN)) BP))
(vlax-make-variant (cdr (assoc 40 EN)))
)
)
((= eType "ARC") ; Add an arc object to the block definition
(vla-addarc
acadObj
(vlax-3d-point (mapcar '- (cdr (assoc 10 EN)) BP))
(vlax-make-variant (cdr (assoc 40 EN)))
(vlax-make-variant (cdr (assoc 50 EN)))
(vlax-make-variant (cdr (assoc 51 EN)))
)
)
((= eType "ATTDEF")
(vla-addattribute
acadObj
(vlax-make-variant (cdr (assoc 40 EN))) ;height
(vlax-make-variant (cdr (assoc 70 EN))) ;mode
(vlax-make-variant (cdr (assoc 2 EN))) ;prompt
(vlax-3d-point (mapcar '- (cdr (assoc 10 EN)) BP)) ;insert point
(vlax-make-variant (cdr (assoc 2 EN))) ;tag
(vlax-make-variant (cdr (assoc 1 EN))) ;default value
)
)
;; Add more objects!
(t
(prompt
(strcat "\nAppend block does not know about "
eType
" objects.")))
)
)
;; RemoveBlock - Given a block name and an entity name of an entity
;; inside the block definition, routine will remove the entity from
;; the definition.
;; Entity name should be selected using something like NENTSEL to
;; obtain the nested entity name.
;; No returning value of interest.
(defun RemoveBlock (BN ;block name
EN ;entity name of object to remove
/
acadObj ;object reference variable
vlEN ;entity object name
)
(setq vlEN (vlax-ename->vla-object EN))
(Vla-delete vlEN)
)
;; Get_Block_Ref_Obj - given block name string this function returns
;; object reference to the block table entry. The extended Active X
;; object references are used to obtain this information.
(defun Get_Block_Ref_Obj (BN ; string name of block
/
acadObj ;AutoCAD object reference symbol
)
(if (tblsearch "BLOCK" BN) ;first check if a valid block
(setq acadObj (vlax-get-acad-object) ;acad object
acadObj (vla-get-documents acadObj) ;documents collection
acadObj (vla-item acadObj (getvar "DWGNAME"))
;current document
acadObj (vla-get-blocks acadObj) ;blocks collection
acadObj (vla-item acadObj BN) ;block object
)
)
)
;; TESTING AND DEMONSTRATION OF USE FUNCTIONS
;; Test 1 prep - new drawing, create some entities, define a block,
;; insert the block at numerous places. Add another entity (LINE or
;; ARC). Run TEST1 pick the nearest insert to the new entity,
;; then pick the new entity - it will become part of the block def.
(defun C:TEST1 ()
(prompt "\nTest/demonstrate the AppendBlock function")
(setq EN1 (entsel "\nPick a block insert: ")
EN1 (entget (car EN1))
EN2 (entsel "\nPick object to add: ")
)
(appendblock
(cdr (assoc 2 EN1))
(car EN2)
(cdr (assoc 10 EN1)))
(command "_REGEN") ;regen display
(princ)
)
;; Test 2 prep - run test 1.
(defun C:TEST2 ()
(prompt "\nTest/demonstrate the RemoveBlock function")
(setq EN1
(nentsel
"\nPick entity inserted in block to remove from definition: "))
(if EN1
(progn
(setq BN (cdr (assoc 2 (entget (car (last EN1)))))
EN1 (car EN1))
(removeBlock BN EN1)
(command "_REGEN")
)
)
)
(prompt "\nFunction set for BlockFun has been loaded. See source for details on test runs.")
(princ)

(vl-load-com) 
;; Bill Kramer - PointA Wizards Lab Scroll 
;; See related article for details about what is going on in this 
;; code!  Function utilities are provided for adding and removing 
;; specific entity objects from block definitions. 
;; AppendBlock - Given a block name, an entity name in model space, 
;; and a base point (normally location of a given insert of the block) 
;; this routine will append the entity to the block definition. 
;; Returns object reference when successful for new item inserted into 
;; the block definition.  Returns nil if the entity type is not supported. 
(defun AppendBlock  (BN         ; block name 
           EN         ; entity name to add 
           BP         ; base point of insert occurance 
           / 
           acadObj      ;object reference variable 
           Etype      ;entity type string 
           ) 
  (setq   acadObj   (Get_Block_Ref_Obj BN)   ;get block reference object 
   EN   (entget EN)      ;entity specifics 
   EType   (cdr (assoc 0 EN))   ;entity descriptive name 
   ) 
  ;; Add... method used to add objects to the block collection object. 
  ;;        is specific for each type of entity you wish to support. 
  (cond 
    ((= eType "LINE")         ; Add a line object to the block definition 
     (vla-addline 
       acadObj 
       (vlax-3d-point (mapcar '- (cdr (assoc 10 EN)) BP)) 
       (vlax-3d-point (mapcar '- (cdr (assoc 11 EN)) BP)) 
       ) 
     ) 
    ((= eType "CIRCLE")         ; Add a circle object to the block definition 
     (vla-addcircle 
       acadObj 
       (vlax-3d-point (mapcar '- (cdr (assoc 10 EN)) BP)) 
       (vlax-make-variant (cdr (assoc 40 EN))) 
       ) 
     ) 
    ((= eType "ARC")         ; Add an arc object to the block definition 
     (vla-addarc 
       acadObj 
       (vlax-3d-point (mapcar '- (cdr (assoc 10 EN)) BP)) 
       (vlax-make-variant (cdr (assoc 40 EN))) 
       (vlax-make-variant (cdr (assoc 50 EN))) 
       (vlax-make-variant (cdr (assoc 51 EN))) 
       ) 
     ) 
    ((= eType "ATTDEF") 
     (vla-addattribute 
       acadObj 
       (vlax-make-variant (cdr (assoc 40 EN))) ;height 
       (vlax-make-variant (cdr (assoc 70 EN))) ;mode 
       (vlax-make-variant (cdr (assoc 2 EN))) ;prompt 
       (vlax-3d-point (mapcar '- (cdr (assoc 10 EN)) BP)) ;insert point 
       (vlax-make-variant (cdr (assoc 2 EN))) ;tag 
       (vlax-make-variant (cdr (assoc 1 EN))) ;default value 
       ) 
     ) 
    ;; Add more objects! 
    (t 
     (prompt 
       (strcat "\nAppend block does not know about " 
          eType 
          " objects."))) 
    ) 
  ) 
;; RemoveBlock - Given a block name and an entity name of an entity 
;; inside the block definition, routine will remove the entity from 
;; the definition. 
;; Entity name should be selected using something like NENTSEL to 
;; obtain the nested entity name. 
;; No returning value of interest. 
(defun RemoveBlock  (BN         ;block name 
           EN         ;entity name of object to remove 
           / 
           acadObj      ;object reference variable 
           vlEN      ;entity object name 
           ) 
  (setq vlEN (vlax-ename->vla-object EN)) 
  (Vla-delete vlEN) 
) 
;; Get_Block_Ref_Obj - given block name string this function returns 
;; object reference to the block table entry.  The extended Active X 
;; object references are used to obtain this information. 
(defun Get_Block_Ref_Obj  (BN      ; string name of block 
            / 
            acadObj   ;AutoCAD object reference symbol 
            ) 
  (if (tblsearch "BLOCK" BN)      ;first check if a valid block 
    (setq acadObj (vlax-get-acad-object) ;acad object 
     acadObj (vla-get-documents acadObj) ;documents collection 
     acadObj (vla-item acadObj (getvar "DWGNAME")) 
               ;current document 
     acadObj (vla-get-blocks acadObj) ;blocks collection 
     acadObj (vla-item acadObj BN)   ;block object 
     ) 
    ) 
  ) 
;; TESTING AND DEMONSTRATION OF USE FUNCTIONS 
;; Test 1 prep - new drawing, create some entities, define a block, 
;; insert the block at numerous places.  Add another entity (LINE or 
;; ARC).  Run TEST1 pick the nearest insert to the new entity, 
;; then pick the new entity - it will become part of the block def. 
(defun C:TEST1   () 
  (prompt "\nTest/demonstrate the AppendBlock function") 
  (setq   EN1 (entsel "\nPick a block insert: ") 
   EN1 (entget (car EN1)) 
   EN2 (entsel "\nPick object to add: ") 
   ) 
  (appendblock 
    (cdr (assoc 2 EN1)) 
    (car EN2) 
    (cdr (assoc 10 EN1))) 
  (command "_REGEN")         ;regen display 
  (princ) 
  ) 
;; Test 2 prep - run test 1. 
(defun C:TEST2   () 
  (prompt "\nTest/demonstrate the RemoveBlock function") 
  (setq   EN1 
    (nentsel 
      "\nPick entity inserted in block to remove from definition: ")) 
  (if EN1 
    (progn 
      (setq BN   (cdr (assoc 2 (entget (car (last EN1))))) 
       EN1   (car EN1)) 
      (removeBlock BN EN1) 
      (command "_REGEN") 
      ) 
    ) 
  ) 
(prompt "\nFunction set for BlockFun has been loaded. See source for details on test runs.") 
(princ)

aeo · 发表于 2003-6-26 20:38:13

找找论坛,有更好的.

账号		自动登录	找回密码
密码			立即注册

[转贴]：添加实体到指定块

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块