[编程交流] 插入具有属性a的块

;--------------------------------------------------------------------------
; INSERTBLK
;--------------------------------------------------------------------------
(defun InsertBlock (bNme Pt)
(vl-load-com)
(vla-InsertBlock
 (if (eq acPaperSpace
   (vla-get-ActiveSpace
   (setq doc (vla-get-ActiveDocument
   (vlax-get-acad-object)))))
   (if (eq :vlax-true (vla-get-MSpace doc))
   (vla-get-ModelSpace doc)
   (vla-get-PaperSpace doc))
   (vla-get-ModelSpace doc))
(vlax-3D-point Pt) bNme 1. 1. 1. 0.)
(setvar "KNUM" bNme)
)
;--------------------------------------------------------------------------
(defun LM:SetAttributeValue ( block tag value )
 ;; © Lee Mac 2010
 (vl-some
   (function
     (lambda ( attrib )
       (if (eq tag (vla-get-TagString attrib))
         (progn (vla-put-TextString attrib value) value)
       )
     )
   )
   (vlax-invoke block 'GetAttributes)
 )
)
;--------------------------------------------------------------------------
;--------------------------------------------------------------------------
(defun c:ins (/ oldPref oldKNR curStr ss)
;(vl-load-com)
(setq snapwert (getvar "snapmode"))
(setvar "snapmode" 1)
;--------------------------------------------------------------------------
 (initget 6)
 (setq numZeros (getInt "\nAnzahl der Stellen Eingeben <4>: "))
 (if(not numZeros)(setq numZeros 4))
 
(defun num2str (num / numStr)
   (setq numStr (itoa num))
   (If (< (strlen numStr) numZeros)
     (repeat (- numZeros (strlen numStr))
   (setq numStr (strcat "0" numStr))
   )
     )
   numStr
   )
;--------------------------------------------------------------------------
;request of Prefix und Start KNR (= cable Number)
;--------------------------------------------------------------------------
(if(not rnm:Pref)(setq rnm:Pref ""))
 (setq oldPref rnm:Pref) 
(if(not rnm:KNR)(setq rnm:KNR 1))
 (setq oldKNR rnm:KNR)
(setq rnm:Pref (getstring T (strcat "\nPrefix: <"rnm:Pref">: "))) 
 (if (= "" rnm:Pref)
   (setq rnm:Pref oldPref)) 
 (if (= " " rnm:Pref)
   (setq rnm:Pref ""))
(setq rnm:KNR (getint (strcat "\nEnter Start KNR <"(itoa rnm:KNR)">: ")))
 (if (null rnm:KNR)
   (setq rnm:KNR oldKNR))
;--------------------------------------------------------------------------
(while T
(setq curStr(strcat rnm:Pref(num2Str rnm:KNR)))
;--------------------------------------------------------------------------
;Insert of Block: ZU-BUS
;--------------------------------------------------------------------------
(setq insPt (getpoint (strcat "\nInsert Point ZU <"curStr">: ")))
(InsertBlock "ZU-BUS" insPt)
;--------------------------------------------------------------------------
;set attribute in Block: ZU-BUS
;--------------------------------------------------------------------------
 (if 
(setq ss (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
   (LM:SetAttributeValue
     (vlax-ename->vla-object (ssname ss 0)) "KNUM" curStr
   )
 )
;--------------------------------------------------------------------------
;Insert of Block: VON-BUS
;--------------------------------------------------------------------------
(setq insPt (getpoint (strcat "\nInsert Point VON <"curStr">: ")))
(InsertBlock "VON-BUS" insPt)
;--------------------------------------------------------------------------
;set attribute in Block: VON-BUS
;--------------------------------------------------------------------------
 (if (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
   (LM:SetAttributeValue
     (vlax-ename->vla-object (ssname ss 0)) "KNUM" curStr
   )
 )
;--------------------------------------------------------------------------
;Increasement of KNR
;--------------------------------------------------------------------------
(setq rnm:KNR(1+ rnm:KNR)) 
(princ curStr)
) ; End while
(princ)
)
;--------------------------------------------------------------------------