替换对象（矩形）
如何用命名块替换对象（矩形）并保留超链接。可以做到吗？比吉·lisp？
Jaap公司 这真的很奇怪。
这项工作的目的是什么？ 它用于dwf文件，为建筑集成系统制作屏幕。超链接已附加到块。有了一个属性，我希望它使超链接在纸/屏幕上可见，便于检查。
它不是一个网络地址，而是这样的东西：根，firemap。探测器2334.43
我使用Autocad Electrical，我可以把它放到excel中。
用命名块替换任何对象（本例中为矩形）很简单，前提是您已经规划了从原始对象提取所需的数据。例如，将在哪里插入命名块，即矩形的质心？
也就是说，这个超链接存储在哪里。。。在矩形还是块上？
如果在矩形上简单地选择矩形，计算插入点，插入命名块，提取超链接信息，并将其应用于块（可能需要一些变化的可见性状态才能使其显示在平面上？）。
希望这有帮助！ 超链接连接到矩形。这是旧图纸中的情况。我想把它们转换成块，这样我就可以在块编辑器中编辑它们，并添加一些属性（TAG1等）以导出到Excel。Lisp程序很好，但问题是。。。当我选择所有要转换的矩形（大约80个）时，它们会从第一个选定的矩形中获得所有超链接。我想有一个块名块，但都有自己的超链接。
Jaap公司
发布您的代码。 (defun c:CTB (/ ss adoc pt_lst center blk *error* lst bpat bname bi first)
;;;Each primitive in a separate named block
(defun *error* (msg)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(setq bpat "BIS-") ;_ <- Edit block name pattern here
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-StartUndoMark
(if (not (vl-catch-all-error-p
(vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
) ;_ end of vl-catch-all-error-p
) ;_ end of not
(progn
(mapcar '(lambda(item)
(setq
ss (list item)
pt_lst (apply 'append
(mapcar
'(lambda (x / minp maxp)
(vla-getboundingbox x 'minp 'maxp)
(list (vlax-safearray->list minp)
(vlax-safearray->list maxp)
) ;_ end of append
) ;_ end of lambda
ss
) ;_ end of mapcar
) ;_ end of append
center (mapcar '(lambda (a b) (/ (+ a b) 2.))
(list (apply 'min (mapcar 'car pt_lst))
(apply 'min (mapcar 'cadr pt_lst))
(apply 'min (mapcar 'caddr pt_lst))
) ;_ end of list
(list (apply 'max (mapcar 'car pt_lst))
(apply 'max (mapcar 'cadr pt_lst))
(apply 'max (mapcar 'caddr pt_lst))
) ;_ end of list
) ;_ end of mapcar
)
(if (null first)
(progn
(setq
bname
(progn
(setq bi 0)
(while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
bname)
blk
(vla-add (vla-get-blocks adoc)
(vlax-3d-point center)
bname
)
) ;_ end of setq
(vla-copyobjects
adoc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
ss
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
blk
);_ end of vla-copyobjects
(setq first t)
)
)
(vla-insertblock
(vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
(vlax-3d-point center)
(vla-get-name blk)
1.0
1.0
1.0
0.0
) ;_ end of vla-insertblock
)
(setq
lst (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
) ;_ end of mapcar
)
)
(mapcar 'vla-erase lst)
) ;_ end of and
) ;_ end of if
(vla-endundomark adoc)
(princ)
) 圣诞快乐：
(defun c:CTB(/ ss mn mx insertPoint blockObj)
(vl-load-com)
(vla-startundomark
(cond
(*activeDoc*)
((setq *activeDoc*
(vla-get-activedocument (vlax-get-acad-object))))))
;; Main code
(if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
(progn
(vlax-for x(setq ss (vla-get-activeselectionset *activeDoc*))
;; Calculate the centroid
(vla-getboundingbox x 'mn 'mx)
(setq insertPoint
(vlax-3d-point
(mapcar '*
(mapcar '+
(vlax-safearray->list mn)
(vlax-safearray->list mx))
'(0.5 0.5 0.5))))
;; Insert block
(setq blockObj
(vla-insertblock
(if (= "MODEL" (strcase (getvar 'ctab)))
(cond (*modelSpace*)
((setq *modelSpace*
(vla-get-modelspace *activeDoc*))))
(cond (*paperSpace*)
((setq *paperSpace*
(vla-get-paperspace *activeDoc*)))))
insertPoint
"blockName.dwg" ; <- Include file path if not in support path
1.
1.
1.
0.))
;; Place block on original object's layer
(vla-put-layer blockObj (vla-get-layer x))
;; Extract hyperlink and add to block
(vlax-for link (vla-get-hyperlinks x)
(vlax-invoke
(vla-get-hyperlinks blockObj)
'add
(vla-get-url link)
(vla-get-urldescription link)
""))
;; Delete original object
(vla-delete x))
;; Delete selection set
(vla-delete ss))
(prompt "\n<!>Nothing Selected<!> "))
(vla-endundomark *activeDoc*)
(princ))
-圣诞老人的小精灵 哇！效果完美。是否有lisp将附加的超链接放入具有选定块的te tag HYPERILNK的属性？
Jaap公司
谢谢
一个单独的Lisp程序？还是作为其中的一部分？
页:
[1]
2