如何向c添加超链接

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

大家好：
此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文件中，以便导出的文件如下所示

登录/注册后可看大图

提前感谢

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

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

copy


(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程序和努力

copy

(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