社区 › Auto Lisp › 多重引线（块）匹配

hkncdrc 发表于 2022-7-5 17:24:00

多重引线（块）匹配

嗨，马斯特斯
 
请帮忙；
 
该项目造成了大量的时间损失，
多重引线，定义块。
在DWG文件中可用。
这个软件能用lisp轻松使用吗？
我在等你的帮助。
 
多重引线匹配。图纸

hkncdrc 发表于 2022-7-5 17:41:36

嗨，亲爱的朋友们
 
对以下内容进行编码，
它工作不好。
你能帮我吗？
 


(defun c:ZX ()
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(setq zz (car (entsel "Kopyalanacak Mleader :>")))
(setq ed (entget zz))
(foreach item ed
(cond ((and (= (car item) 330)
(= (cdr (assoc 0 (entget (cdr item)))) "ATTDEF")
)
(setq rec T)
)
((= (car item) 302)
(if rec
(setq attnamelst
(cons (cdr item) attnamelst)
rec nil
)))))
(setq attnamelst (reverse attnamelst))
(setq tip (car attnamelst))
(setq kot (cadr attnamelst))
(setq kod (caddr attnamelst))


(while (setq ent (entsel "Hedef Mleader :>"))
(setq ed (entget (car ent)))
(foreach item ed
(if (= (car item) 330)
(setq attnamelst (cons (vlax-ename->vla-object (cdr item))
attnamelst))))


(setq kodtag (vla-get-tagstring (nth 0 attnamelst)))

(vla-SetBlockAttributeValue
(vlax-ename->vla-object (car ent))
(vla-get-objectid (nth 0 attnamelst))
kod
)


(setq kottag (vla-get-tagstring (nth 1 attnamelst)))

(vla-SetBlockAttributeValue
(vlax-ename->vla-object (car ent))
(vla-get-objectid (nth 1 attnamelst))
kot
)


(setq tiptag (vla-get-tagstring (nth 2 attnamelst)))
(vla-SetBlockAttributeValue
(vlax-ename->vla-object (car ent))
(vla-get-objectid (nth 2 attnamelst))
tip
)
);while



(setq attnamelst nil)


(setq tiptag nil)
(setq kodtag nil)
(setq kottag nil)
(vla-endundomark doc)


(princ))

hkncdrc 发表于 2022-7-5 18:00:53

我的朋友们
问题已解决。
非常感谢。
我为想要使用的朋友分享。
 


(defun c:ZX (/ doc zz ed rec attnamelst tip kod kot ent kodtag kottag tiptag)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq zz (car (entsel "Kopyalanacak Mleader :>")))
(setq ed (entget zz))
(foreach item ed
(cond ((and (= (car item) 330)
(= (cdr (assoc 0 (entget (cdr item)))) "ATTDEF")
)
(setq rec T)
)
((= (car item) 302)
(if rec
(setq attnamelst
(cons (cdr item) attnamelst)
rec nil
)))))
(setq attnamelst (reverse attnamelst))
(setq tip (car attnamelst))
(setq kot (cadr attnamelst))
(setq kod (caddr attnamelst))


(while (setq ent (entsel "Hedef Mleader :>"))
(setq ed (entget (car ent)))
(foreach item ed
(if (= (car item) 330)
(setq attnamelst (cons (vlax-ename->vla-object (cdr item))
attnamelst))))


(setq kodtag (vla-get-tagstring (nth 0 attnamelst)))

(vla-SetBlockAttributeValue
(vlax-ename->vla-object (car ent))
(vla-get-objectid (nth 0 attnamelst))
kod
)


(setq kottag (vla-get-tagstring (nth 1 attnamelst)))

(vla-SetBlockAttributeValue
(vlax-ename->vla-object (car ent))
(vla-get-objectid (nth 1 attnamelst))
kot
)


(setq tiptag (vla-get-tagstring (nth 2 attnamelst)))
(vla-SetBlockAttributeValue
(vlax-ename->vla-object (car ent))
(vla-get-objectid (nth 2 attnamelst))
tip
)
);while



(setq attnamelst nil)


(setq tiptag nil)
(setq kodtag nil)
(setq kottag nil)


(princ))

halam 发表于 2022-7-5 18:19:07

 
很高兴它对你有用。你能再描述一下什么解决方案解决了什么问题吗。。？
我的Chechislogakian与Dutches不太接近；-）

hkncdrc 发表于 2022-7-5 18:36:25

 
你好
抄写一些错误地方的文章时出现问题。
 
http://i.hizliresim.com/WYB14m.png
 
非常感谢。
我的英语不好，是的）

查看完整版本: 多重引线（块）匹配