handasa 发表于 2022-7-5 17:18:12

如何向c添加超链接

大家好：
此lisp由Tharwat先生在本网站的某个地方开发
 
(defun c:Test (/ s f o)
;; Tharwat 26. 08. 2015 ;
(princ "\nSelect LWpolylines to export to Excel file :")
(if (and (setq s (ssget '((0 . "LWPOLYLINE"))))
          (setq f (getfiled "Specify File Name" (getvar 'DWGPREFIX) "csv" 1))
          (setq o (open f "w"))
          )
   (progn
   ((lambda (r / e)
      (while (setq e (ssname s (setq r (1+ r))))
          (write-line (rtos (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 2 4) o)
          ))
       -1)
   (close o)
   )
   )         
(princ)
)
 
 
 
如何将选定多段线的heperlinks添加到导出的csv文件中，以便导出的文件如下所示
 
http://sl.uploads.im/t/qye5Y.jpg
 
 
提前感谢

Tharwat 发表于 2022-7-5 17:28:49

你好
在代码上试试这个[未经测试的]mods，然后告诉我：
 

(defun c:Test (/ s f o)
;; Tharwat 28. 08. 2016 ;
(princ "\nSelect LWpolylines to export to Excel file :")
(if (and (setq s (ssget '((0 . "LWPOLYLINE"))))
          (setq f (getfiled "Specify File Name" (getvar 'DWGPREFIX) "csv" 1))
          (setq o (open f "w"))
          )
   (progn
   (write-line "Polyline Length;Polyline Hyperlink" o)
   ((lambda (r / e l d ur)
      (while (setq e (ssname s (setq r (1+ r))))
          (vlax-for hp (vla-get-hyperlinks (vlax-ename->vla-object e))
            (if (setq ur (vla-get-url hp))
            ur)
            )
          (write-line (strcat (rtos (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 2 4)
                     ";" (if ur ur "")) o)
   ))
-1)
   (close o)
   )
   )         
(princ)
)(vl-load-com)

handasa 发表于 2022-7-5 17:35:34

谢谢tharwat先生。。。但是lisp为csv文件中的超链接导出空单元格

handasa 发表于 2022-7-5 17:42:09

你（tharwat先生）写的另一个lisp，我尝试过并添加了提取超链接和长度到表中的部分
 
谢谢塔瓦特先生的Lisp程序和努力
 
(defun c:ltt (/ pt2 pt3 s x y doc objtable numrows rowheight pt1 colwidth curspace)
;; Tharwat 26. 08. 2015 ;
;; mods by BIGAL 29.08.2015 now as table

(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-modelspace doc))
(setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table:")))
;(princ "\nSelect LWpolylines to export to a Table :")

(setq pt2 (getpoint "Select by fence-line 1st set of entities : "))
(setq pt3 (getpoint pt2 "2nd point of fence-line: ")
       s (ssget "F" (list pt2 pt3))
) ;_ end of setq

;(setq s (ssget '((0 . "LWPOLYLINE"))))

(if (/= s nil)
   (progn
; now do table
   (setq numrows (+ 2 (sslength s)))
   (setq numcolumns 3)
   (setq rowheight 7)
   (setq colwidth 25)
   (setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
   (vla-settext objtable 0 0 "Pline lengths")
   (vla-setcolumnwidth objtable 0 10)
   (vla-setcolumnwidth objtable 1 25)
   (vla-settext objtable 1 0 "Pline")
   (vla-settext objtable 1 1 "Length")
(vla-settext objtable 1 2 "hyperlinks")
   (vla-SetTextHeight Objtable (+ acDataRow acHeaderRow acTitleRow) 2.5)
   (vla-SetAlignment Objtable acDataRow acMiddleCenter)

   (setq x 1)
   (SETQ Y 2)
   (setq r -1)
   ;((lambda (r / e)

      (while (setq e (vlax-ename->vla-object(ssname s (setq r (1+ r)))))
      (vla-settext objtable Y 0 (rtos x 2 0))      
      (vla-settext objtable Y 1 (rtos(vla-get-length e)2 4))
       (setq hypers (vlax-get-property e 'Hyperlinks))
       (vla-settext objtable Y 2 (vlax-get-property (vla-item hypers 0) 'URL))
          ;(setq vlaObj (vlax-ename->vla-object en))
       ;(setq hypers (vlax-get-property e 'Hyperlinks))
      (setq x (1+ x ))
      (setq y (1+ Y ))
); while
    ; )) ;lambda
   )   ;progn
   (alert "You have not picked any plines run again")
   )   ; if      
(princ)

) ; defun

Tharwat 发表于 2022-7-5 17:54:56

 
你能上传一张样图吗？

handasa 发表于 2022-7-5 17:59:57

附着的dwg文件包含具有超链接的多段线，编号从1到8，具有超链接的多段线。图纸

Tharwat 发表于 2022-7-5 18:10:38

我更新了上述代码，请重试。

handasa 发表于 2022-7-5 18:14:43

谢谢tharwat先生
Lisp程序非常有效

Tharwat 发表于 2022-7-5 18:24:06

 
非常欢迎你。
谢谢你的回复。
页: [1]
查看完整版本: 如何向c添加超链接