从块中提取超链接

Cylis0509 · 发表于 2022-7-5 16:23:08

大家好，

我已经创建了这个lisp，它工作得很好，但我需要一件事的帮助。这将从块中提取超链接，并按照您选择块的顺序将其导出到txt文件。

这是我的问题。显然，有两种方法可以向块添加超链接。您可以通过块编辑器将其添加到属性窗格（图1）中，也可以将其添加到块外部。（图2）希望是有道理的。

如果超链接在外面，下面的例程就会起作用，当然，我所有的块都在里面。

如何修改此选项以提取“嵌套”超链接？

我还注意到，如果取消txt保存对话框，会出现以下错误：；错误：错误的参数类型：stringp nil
我不知道为什么。。。

copy


(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

Lee Mac · 发表于 2022-7-5 16:29:43

请注意，当使用ssget获取选择时，不能依赖集合中实体的顺序与选择顺序匹配（考虑窗口/交叉/多边形/组选择）。

因为在将值提供给打开函数之前，您没有测试GetField函数是否返回了字符串值。如果用户在提示时单击“取消”，则GetField将返回nil，因此，当提供空文件名参数时，open函数将出错。

我建议如下：

copy


([color=BLUE]defun[/color] c:hypex ( [color=BLUE]/[/color] des ent hyp lst txt url )
   ([color=BLUE]setq[/color] hyp ([color=BLUE]lambda[/color] ( ent ) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 1000 ([color=BLUE]cdadr[/color] ([color=BLUE]assoc[/color] -3 ([color=BLUE]entget[/color] ent '([color=MAROON]"pe_url"[/color]))))))))
   ([color=BLUE]while[/color]
       ([color=BLUE]not[/color]
           ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] ent ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect block <done>: "[/color])))
               ([color=BLUE]cond[/color]
                   (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                       ([color=BLUE]prompt[/color] [color=MAROON]"\nMissed, try again."[/color])
                   )
                   (   ([color=BLUE]null[/color] ent))
                   (   ([color=BLUE]/=[/color] [color=MAROON]"INSERT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] ent))))
                       ([color=BLUE]prompt[/color] [color=MAROON]"\nThe selected object is not a block."[/color])
                   )
                   (   ([color=BLUE]not[/color] ([color=BLUE]setq[/color] url ([color=BLUE]cond[/color] ((hyp ent)) ((hyp ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 330 ([color=BLUE]entget[/color] ([color=BLUE]tblobjname[/color] [color=MAROON]"block"[/color] (LM:name->effectivename ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 ([color=BLUE]entget[/color] ent)))))))))))))
                       ([color=BLUE]prompt[/color] [color=MAROON]"\nThe selected block does not contain a hyperlink."[/color])
                   )
                   (   ([color=BLUE]=[/color] [color=MAROON]""[/color] url)
                       ([color=BLUE]prompt[/color] [color=MAROON]"\nThe hyperlink for the selected block is linked to a view."[/color])
                   )
                   (   ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] url lst))
                       ([color=BLUE]prompt[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nURL = "[/color] url))
                   )
               )
           )
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] lst ([color=BLUE]setq[/color] txt ([color=BLUE]getfiled[/color] [color=MAROON]""[/color] ([color=BLUE]strcat[/color] [color=MAROON]"Export - "[/color]([color=BLUE]menucmd[/color] [color=MAROON]"M=$(edtime,0,MO-DD-YYYY)"[/color])) [color=MAROON]"txt"[/color] 1)))
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] des ([color=BLUE]open[/color] txt [color=MAROON]"w"[/color]))
           ([color=BLUE]progn[/color]
               ([color=BLUE]foreach[/color] url ([color=BLUE]reverse[/color] lst) ([color=BLUE]write-line[/color] url des))
               ([color=BLUE]close[/color] des)
           )
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nUnable to open "[/color] txt [color=MAROON]" for writing."[/color]))
       )
   )
   ([color=BLUE]princ[/color])
)
[color=GREEN];; Block Name -> Effective Block Name  -  Lee Mac[/color]
[color=GREEN];; blk - [str] Block name[/color]
([color=BLUE]defun[/color] LM:name->effectivename ( blk [color=BLUE]/[/color] rep )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color] ([color=BLUE]wcmatch[/color] blk [color=MAROON]"`**"[/color])
           ([color=BLUE]setq[/color] rep
               ([color=BLUE]cdadr[/color]
                   ([color=BLUE]assoc[/color] -3
                       ([color=BLUE]entget[/color]
                           ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 330 ([color=BLUE]entget[/color] ([color=BLUE]tblobjname[/color] [color=MAROON]"block"[/color] blk))))
                          '([color=MAROON]"AcDbBlockRepBTag"[/color])
                       )
                   )
               )
           )
           ([color=BLUE]setq[/color] rep ([color=BLUE]handent[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 1005 rep))))
       )
       ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 ([color=BLUE]entget[/color] rep)))
       blk
   )
)
([color=BLUE]princ[/color])

Cylis0509 · 发表于 2022-7-5 16:33:54

嘿，李，

非常感谢你。你的日常活动很棒。但它仍然只拉外部超链接。不是嵌套在块中的那个。。。有什么想法吗？我似乎找不到这方面的任何东西。

谢谢你的帮助！！！

Lee Mac · 发表于 2022-7-5 16:38:06

它在我的测试中效果很好-请上传一个样本图。

Cylis0509 · 发表于 2022-7-5 16:41:32

当然没问题，附件。

我想我缩小了问题的范围。。。

在创建示例图形时，我发现您的例程工作正常、嵌套或在外部。所以我开始研究不同之处。我的区块包含动态功能。只要我添加了一些动态功能。您的例程不再适用于嵌套超链接。

我相信这与我最近学习的动态块、块名和块真名有关*U69与海平。只是猜测而已。

再次感谢你。

超链接测试。图纸

Grrr · 发表于 2022-7-5 16:46:48

这就是为什么我不依赖组码2，这是动态块可能性的原因：

copy


(if (wcmatch (setq n (cdr (assoc 2 (entget ent)))) "`*U*")
 (setq n (vla-get-EffectiveName (vlax-ename->vla-object ent)))
)

Lee Mac · 发表于 2022-7-5 16:48:57

是的，动态块-我现在已经更新了我的上述代码。

Cylis0509 · 发表于 2022-7-5 16:52:08

谢谢Grrr和李，我真的很感激。最后一个问题。。。

我知道这违背了李所说的选择，但只是为了我自己的启发；如果我使用Lee的LM:ssget，我将如何将有效名称的解决方案合并到以下内容中：

copy


(setq ss_dtl 
(LM:ssget "\nSelect details in order for export or [Fence]: "
(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"))))))
)

Grrr · 发表于 2022-7-5 16:55:58

我不认为只有使用ssget过滤器才能过滤入/出动态块。。
是的，您可以找到哪些块名称定义是动态的，并将其包含在过滤器中，但它不会选择具有注释性名称的动态块参照。

因此，我将迭代选择集并删除外部参照块。。

copy


(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确定块定义是否是动态的？

Cylis0509 · 发表于 2022-7-5 17:00:23

吼叫声

所以我会注射/替换我的重复是？

copy


(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 [Fence]: "
                                
                                (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)
)

[编程交流] 从块中提取超链接

发表回复

精选推荐