两个不同的块值Com
我有点Lisp程序，但这是我无法做到的，所以我希望有人能帮助我。我一直在寻找一种方法来做到以下几点：[列表]
[*]选择第一个块（SL Dev）并获取属性标记ID_1的值（对于多个选择保持不变）
[*]选择第二个块（SL Con）并获取_1中属性标记的值
[*]将两个值放置在（ID_1 IN_1）之间的空格中，并将新值放回第二个块（SL Con），属性标记在附近
[*]然后，我想通过单击多个SL Con块并使用其在_1中的标记与原始SL_DEV tag ID_1结合来继续此过程
[/列表]
对我来说似乎很棘手，但任何帮助都将不胜感激 未经测试。。。
(defun c:ID_1-sour+IN_1-dest->NEAR-dest ( / s b1 sourval1 b2 sourval2 destval )
(vl-load-com)
(prompt "\nPick (SL-Dev) block reference...")
(setq s (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1))))
(while (or (not s) (vlax-property-available-p (setq b1 (vlax-ename->vla-object (ssname s 0))) 'Path) (/= (vla-get-effectivename b1) "SL-Dev"))
(prompt "\nMissed or wrong block reference pick or picked xref... Try picking (SL-Dev) block reference again...")
(setq s (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1))))
)
(foreach att (append (vlax-invoke b1 'getattributes) (vlax-invoke b1 'getstaticattributes))
(if (= (vla-get-tagstring att) "ID_1")
(setq sourval1 (vla-get-textstring att))
)
)
(while t
(prompt "\nPick (SL-Con) block reference... ESC to terminate and finish picking (SL-Con) block references...")
(setq s (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
(while (or (not s) (vlax-property-available-p (setq b2 (vlax-ename->vla-object (ssname s 0))) 'Path) (/= (vla-get-effectivename b2) "SL-Con"))
(prompt "\nMissed or wrong block reference pick or picked xref... Try picking (SL-Con) block reference again...")
(setq s (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
)
(foreach att (append (vlax-invoke b2 'getattributes) (vlax-invoke b2 'getstaticattributes))
(if (= (vla-get-tagstring att) "IN_1")
(setq sourval2 (vla-get-textstring att))
)
)
(setq destval (strcat sourval1 " " sourval2))
(foreach att (append (vlax-invoke b2 'getattributes) (vlax-invoke b2 'getstaticattributes))
(if (= (vla-get-tagstring att) "NEAR")
(vla-put-textstring att destval)
)
)
)
(princ)
)
给你图片它应该是什么样子。。。 正如我说的那样。。。
然而，我确实加载并运行了它，这是我在选择SL-DEV块后得到的结果（如果这有什么不同的话，它是动态的）。
拾取（SL Dev）块参考。。。
选择对象：
; 错误：ActiveX服务器返回错误：未知名称：“GETSTATICATTRIBUTES” 替换（append（vlax invoke'getattributes）（vlax invoke'getstaticattributes））。。。在发布的代码中，所有情况下都会出现（append（vlax invoke'getattributes）（vlax invoke'getconstantattributes））。。。我没有时间，你必须独自调试它。。。 请尝试以下未经测试的代码：
(defun c:combatt ( / ent id1 idx in1 sel )
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect SL-DEV block <exit>: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null ent) nil)
( (/= "INSERT" (cdr (assoc 0 (entget ent))))
(princ "\nSelected object is not a block.")
)
( (/= "SL-DEV" (strcase (LM:al-effectivename ent)))
(princ "\nSelected block is not an \"SL-DEV\" block.")
)
( (not (setq id1 (LM:getattributevalue ent "ID_1")))
(princ "\nBlock does not contain \"ID_1\" attribute.")
)
)
)
)
(if
(and id1
(setq sel
(ssget "_:L"
(list '(0 . "INSERT") '(66 . 1)
(cons 2
(apply 'strcat
(cons "SL-CON"
(mapcar '(lambda ( x ) (strcat ",`" x))
(LM:getanonymousreferences "SL-CON")
)
)
)
)
)
)
)
)
(repeat (setq idx (sslength sel))
(if (setq ent (ssname sel (setq idx (1- idx)))
in1 (LM:getattributevalue ent "IN_1")
)
(LM:setattributevalue ent "NEAR" (strcat id1 in1))
)
)
)
(princ)
)
;; Get Anonymous References-Lee Mac
;; Returns the names of all anonymous references of a block.
;; blk - Block name/wildcard pattern for which to return anon. references
(defun LM:getanonymousreferences ( blk / ano def lst rec ref )
(setq blk (strcase blk))
(while (setq def (tblnext "block" (null def)))
(if
(and (= 1 (logand 1 (cdr (assoc 70 def))))
(setq rec
(entget
(cdr
(assoc 330
(entget
(tblobjname "block"
(setq ano (cdr (assoc 2 def)))
)
)
)
)
)
)
)
(while
(and
(not (member ano lst))
(setq ref (assoc 331 rec))
)
(if
(and
(entget (cdr ref))
(wcmatch (strcase (LM:al-effectivename (cdr ref))) blk)
)
(setq lst (cons ano lst))
)
(setq rec (cdr (member (assoc 331 rec) rec)))
)
)
)
(reverse lst)
)
;; Effective Block Name-Lee Mac
;; ent - Block Reference entity
(defun LM:al-effectivename ( ent / blk rep )
(if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
(if
(and
(setq rep
(cdadr
(assoc -3
(entget
(cdr
(assoc 330
(entget
(tblobjname "block" blk)
)
)
)
'("acdbblockrepbtag")
)
)
)
)
(setq rep (handent (cdr (assoc 1005 rep))))
)
(setq blk (cdr (assoc 2 (entget rep))))
)
)
blk
)
;; Get Attribute Value-Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - Block (Insert) Entity Name
;; tag - Attribute TagString
;; Returns: Attribute value, else nil if tag is not found.
(defun LM:getattributevalue ( blk tag / enx )
(if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
(if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
(cdr (assoc 1 enx))
(LM:getattributevalue blk tag)
)
)
)
;; Set Attribute Value-Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - Block (Insert) Entity Name
;; tag - Attribute TagString
;; val - Attribute Value
;; Returns: Attribute value if successful, else nil.
(defun LM:setattributevalue ( blk tag val / enx )
(if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
(if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
(if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
(progn
(entupd blk)
val
)
)
(LM:setattributevalue blk tag val)
)
)
)
(princ)
上面使用了我的属性函数&获取匿名引用函数。 李，你就是那个男人！！！很有魅力谢谢！
太好了-不客气！ 李，我们已经用了将近一年了，不是（再次感谢）我们发现了一些我们想要更改的项目。我尝试了一些事情，但没有成功，所以我希望你或其他人可以帮助改变。
最初我们有两个块来从SL Dev和SL Con提取信息，现在我们要寻找的是能够为第一个选择集选择SL Dev或SL-Dev2，为第二个选择集选择SL Con、SL-Con2、SL-Con3、SL-Con4。SL Dev和SL-Dev2的属性标记与SL Con块的标记相同。
我似乎不知道如何增加选择集，所以如果有任何帮助，我将不胜感激。
更改以下内容：
第12行来自：
( (/= "SL-DEV" (strcase (LM:al-effectivename ent)))至：
第28行：
(cons "SL-CON"至：
(cons "SL-CON,SL-CON"第30行来自：
(LM:getanonymousreferences "SL-CON")至：
7 李，
谢谢你的快速回复，效果很好！非常感谢你。这是项目和名单上的缺点，绊倒了我，我仍然有很多要学习。
再次感谢！
页:
[1]
2