插入具有属性a的块
你好我是个新手,需要帮助。
我需要一个lisp插入两个块交替电缆编号。第一个区块是电缆的起点,第二个区块是目的地。块具有一个名为KNUM的值的属性。在此KNUM中,应插入cablenumber。我在本论坛其他LISP的帮助下编写了以下LISP。是可行的,但目前我必须插入块,并且必须选择插入的块,它将值KNUM更改为我的电缆编号。
有人能帮我吗?
例如,在插入块时设置值,
或者通过插入点选择一个块,这样我就不必再次单击插入的块了?
;--------------------------------------------------------------------------
; 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)
)
;-------------------------------------------------------------------------- 附件是我写的一个旧的,我很快用一些新的潜艇更新了它,它可能会对你有所帮助。这些设置都在代码的顶部。
递增属性编号。lsp 非常感谢。
我会尝试插入我的LISP或适合你的 看看你的代码,我想我的代码已经快到了 尝试使用Binc或BincA命令
页:
[1]