从块中提取超链接
大家好，我已经创建了这个lisp，它工作得很好，但我需要一件事的帮助。这将从块中提取超链接，并按照您选择块的顺序将其导出到txt文件。
这是我的问题。显然，有两种方法可以向块添加超链接。您可以通过块编辑器将其添加到属性窗格（图1）中，也可以将其添加到块外部。（图2）希望是有道理的。
如果超链接在外面，下面的例程就会起作用，当然，我所有的块都在里面。
如何修改此选项以提取“嵌套”超链接？
我还注意到，如果取消txt保存对话框，会出现以下错误：；错误：错误的参数类型：stringp nil
我不知道为什么。。。
(defun c:test6 (/ )
(vl-load-com)
(setq File1 (getfiled "Save File" (strcat "Export - "(menucmd "M=$(edtime,$(getvar,date),MO-DD-YYYY)")) "txt" 1))
(setq Fopen (open File1 "w"))
(setq ss_mm (ssget (list (cons 0 "INSERT"))))
(setq Ecount 0)
(repeat (sslength ss_mm)
(setq mm_obj (vlax-ename->vla-object (ssname ss_mm Ecount)))
(setq mm_txt (vlax-get-property mm_obj 'Hyperlinks))
(progn
(vlax-for each mm_txt
(setq hyp_txt (strcat (vla-get-url each)))
(write-line hyp_txt Fopen)
(setq Ecount (1+ Ecount))
)
)
)
(close Fopen)
(princ)
)
图1
图2
请注意，当使用ssget获取选择时，不能依赖集合中实体的顺序与选择顺序匹配（考虑窗口/交叉/多边形/组选择）。
因为在将值提供给打开函数之前，您没有测试GetField函数是否返回了字符串值。如果用户在提示时单击“取消”，则GetField将返回nil，因此，当提供空文件名参数时，open函数将出错。
我建议如下：
(defun c:hypex ( / des ent hyp lst txt url )
(setq hyp (lambda ( ent ) (cdr (assoc 1000 (cdadr (assoc -3 (entget ent '("pe_url"))))))))
(while
(not
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect block <done>: ")))
(cond
( (= 7 (getvar 'errno))
(prompt "\nMissed, try again.")
)
( (null ent))
( (/= "INSERT" (cdr (assoc 0 (entget ent))))
(prompt "\nThe selected object is not a block.")
)
( (not (setq url (cond ((hyp ent)) ((hyp (cdr (assoc 330 (entget (tblobjname "block" (LM:name->effectivename (cdr (assoc 2 (entget ent)))))))))))))
(prompt "\nThe selected block does not contain a hyperlink.")
)
( (= "" url)
(prompt "\nThe hyperlink for the selected block is linked to a view.")
)
( (setq lst (cons url lst))
(prompt (strcat "\nURL = " url))
)
)
)
)
)
(if (and lst (setq txt (getfiled "" (strcat "Export - "(menucmd "M=$(edtime,0,MO-DD-YYYY)")) "txt" 1)))
(if (setq des (open txt "w"))
(progn
(foreach url (reverse lst) (write-line url des))
(close des)
)
(princ (strcat "\nUnable to open " txt " for writing."))
)
)
(princ)
)
;; Block Name -> Effective Block Name-Lee Mac
;; blk - Block name
(defun LM:name->effectivename ( blk / rep )
(if
(and (wcmatch blk "`**")
(setq rep
(cdadr
(assoc -3
(entget
(cdr (assoc 330 (entget (tblobjname "block" blk))))
'("AcDbBlockRepBTag")
)
)
)
)
(setq rep (handent (cdr (assoc 1005 rep))))
)
(cdr (assoc 2 (entget rep)))
blk
)
)
(princ)
嘿，李，
非常感谢你。你的日常活动很棒。但它仍然只拉外部超链接。不是嵌套在块中的那个。。。有什么想法吗？我似乎找不到这方面的任何东西。
谢谢你的帮助！！！ 它在我的测试中效果很好-请上传一个样本图。 当然没问题，附件。
我想我缩小了问题的范围。。。
在创建示例图形时，我发现您的例程工作正常、嵌套或在外部。所以我开始研究不同之处。我的区块包含动态功能。只要我添加了一些动态功能。您的例程不再适用于嵌套超链接。
我相信这与我最近学习的动态块、块名和块真名有关*U69与海平。只是猜测而已。
再次感谢你。
超链接测试。图纸 这就是为什么我不依赖组码2，这是动态块可能性的原因：
(if (wcmatch (setq n (cdr (assoc 2 (entget ent)))) "`*U*")
(setq n (vla-get-EffectiveName (vlax-ename->vla-object ent)))
) 是的，动态块-我现在已经更新了我的上述代码。 谢谢Grrr和李，我真的很感激。最后一个问题。。。
我知道这违背了李所说的选择，但只是为了我自己的启发；如果我使用Lee的LM:ssget，我将如何将有效名称的解决方案合并到以下内容中：
(setq ss_dtl
(LM:ssget "\nSelect details in order for export or : "
(list "_:L"
(append '((0 . "INSERT"))
((lambda ( / def lst )(while (setq def (tblnext "block" (null def)))
(if (= 4 (logand 4 (cdr (assoc 70 def)))) (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))))
(if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))))
(if (= 1 (getvar 'cvport)) (list (cons 410 (getvar 'ctab))) '((410 . "Model"))))))
)
我不认为只有使用ssget过滤器才能过滤入/出动态块。。
是的，您可以找到哪些块名称定义是动态的，并将其包含在过滤器中，但它不会选择具有注释性名称的动态块参照。
因此，我将迭代选择集并删除外部参照块。。
(repeat (setq idx (sslength ss_dtl))
(setq e (ssname ss_dtl (setq idx (1- idx))))
(setq o (vlax-ename->vla-object e))
(and (eq :vlax-true (vla-get-IsXref o)) (ssdel ss_dtl e) )
)
你的问题让我问李：
如何使用vanilla确定块定义是否是动态的？ 吼叫声
所以我会注射/替换我的重复是？
(defun c:mcdldlf ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt )
(if (and
(setq ss_dtl
(LM:ssget "\nSelect details in order for export or : "
(list "_:L"
(append '((0 . "INSERT"))
(
(lambda ( / def lst )
(while (setq def (tblnext "block" (null def)))
(if (= 4 (logand 4 (cdr (assoc 70 def)))) (setq lst (vl-list* "," (cdr (assoc 2 def)) lst)))
)
(if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))
)
)
(if (= 1 (getvar 'cvport)) (list (cons 410 (getvar 'ctab))) '((410 . "Model")))
)
)
)
)
(setq dtl_export (getfiled "Save Export File" (strcat "Export - "(menucmd "M=$(edtime,$(getvar,date),MO-DD-YYYY)")) "txt" 1))
(setq dtl_export_open (open dtl_export "w"))
)
(progn
(setq dtl_count 0)
(repeat (sslength ss_dtl)
(setq dtl_obj (vlax-ename->vla-object (ssname ss_dtl dtl_count)))
(setq dtl_hyp (vlax-get-property dtl_obj 'Hyperlinks))
(vlax-for each dtl_hyp
(setq hyp_txt (strcat (vla-get-url each)))
(write-line hyp_txt dtl_export_open)
)
(setq dtl_count (1+ dtl_count))
)
(close dtl_export_open)
(princ (strcat "\nA hyperlink from " (itoa dtl_count) " Detail(s) has been exported to a .txt file."))
)
)
(princ)
)
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
页:
[1]
2