Jump to content

custom named polyline question


exceed

Recommended Posts

(defun C:WIRE (/ a b option sel hlinks)
   (setvar "cmdecho" 0)
   (initget "t w e")
   (princ "Polyline Tag = ")
   (princ str)
   (princ " / Last Point = ")
   (princ q)
   (setq a (entsel "\nWiring Tool. Select Option [ChangeTag(t)/Draw(w)/Elevation(e)]:"))
   (if (= a nil)
        (progn
           (vl-cmdf "_.pline")
           (while (= 1 (logand 1 (getvar 'cmdactive))) (vl-cmdf "\\"))
           (setq ss (ssget "l" :s))
             (if ss
               (progn
                 (setq obj (vlax-ename->vla-object (ssname ss 0)))
                 (setq hlinks (vlax-get-property obj 'Hyperlinks))
                 (vla-add hlinks str)
               )
             )
           (c:wire)
        )
   )
   (if (= a "t")
        (progn
           (setq str (getstring "\nChange Tag :"))
           (c:wire)
        )
   )
   (if (= a "w")
        (progn
           (vl-cmdf "_.pline")
           (while (= 1 (logand 1 (getvar 'cmdactive))) (vl-cmdf "\\"))
           (setq ss (ssget "l" :s))
             (if ss
               (progn
                 (setq obj (vlax-ename->vla-object (ssname ss 0)))
                 (setq hlinks (vlax-get-property obj 'Hyperlinks))
                 (vla-add hlinks str)
               )
             )
           (c:wire)
        )
   )
   (if (= a "e")
        (progn
           (setq r (getpoint "point"))
           (setq s (getint "elevation"))
           (repeat s
              (command "._pline" r "@0.25<45" "@0.25<135" "@0.25<225" "@0.25<315" c)
              (setq ss (ssget "l" :s))
                 (if ss
                  (progn
                    (setq obj (vlax-ename->vla-object (ssname ss 0)))
                    (setq hlinks (vlax-get-property obj 'Hyperlinks))
                    (vla-add hlinks str)
                  )
                 )
          )
       )
   (c:wire)
   )
)

 

 

Hello. I want to make custom polyline tool, which is naming with hyperlink property.

- elevation(e) is expression for z-axis length in 2d plane. (shape does not matter)

- use DATAEXTRACTION for length listing sort by polyline name(hyperlink)

 

so, I just make this code.

 

It works. but It's hard to make continuously.

ex) draw straight(w) -> elevation(e) -> draw straight(w) -> ...etc = in 1 polyline. 

and exit with esc or spacebar.

 

how do i modify it?

Thanks for reading.

 

Link to comment
Share on other sites

Updated your code a bit with comments.

 

(defun C:WIRE (/ str q a hlinks ss r s)
  (setvar "cmdecho" 0)
  (defun *error* ()  ;will stop the error when you hit esc
    (command nil nil nil)
    (if (not (member *error* '("Function cancelled")))
      (princ (strcat "\nError: " *error*))
    )
  )
  (while  ;gets rid of the (C:wire)'s
    (or (setq str (vlax-ldata-get "Tag" "str")) (setq str (getstring "\nTag :")))  ;ldata will persist when a drawing is saved.
    (or (setq q (vlax-ldata-get "Tag" "q")) (setq q "N/A"))        ;ldata persists even when variables are declared in the defun.
    (princ (strcat "\nPolyline Tag: " str " \\ Last Point: " (vl-princ-to-string q)))  ;can combine into one line with strcat.
    (initget "t w e")
    (setq a
      (cond
        ((getkword "\nWiring Tool [Changetag(t)/Draw(w)/Elevation(e)]:")) ( "w") ;defaults to w with right click or enter.
      )
    )
    (cond  ;cond is the better choice here
      ((= a "t")
        (setq str (getstring "\nChange Tag :"))
        (vlax-ldata-put "Tag" "str" str)  ;save value to ldata
      )
      ((= a "e")
        (if (and (setq r (getpoint "\nPick Point")) (setq s (getint "\nSet Elevation: ")))  ;runs once it was repeating s times
          (progn
            (setq r (reverse (cons s (cdr (reverse r))))) ;replaces point r's z value with s value
            (vlax-ldata-put "Tag" "q" r) ;maybe not needed?
            (command "._pline" r "@0.25<45" "@0.25<135" "@0.25<225" "C") ; c was for close?
            (setq ss (ssget "l" :s))
            (if ss
              (progn
                (setq obj (vlax-ename->vla-object (ssname ss 0)))
                (setq hlinks (vlax-get-property obj 'Hyperlinks))
                (vla-add hlinks str)
              )
            )
          )
        )
      )
      ((= a "w")
        (prompt "\nDraw Polyline")
        (vl-cmdf "_.pline")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (vlax-ldata-put "Tag" "q" (getvar 'lastpoint))
        (setq ss (ssget "l" :s))
        (if ss
          (progn
            (setq obj (vlax-ename->vla-object (ssname ss 0)))
            (setq hlinks (vlax-get-property obj 'Hyperlinks))
            (vla-add hlinks str)
          )
        )
      )
    )
  )
)

 

Edited by mhupp
Link to comment
Share on other sites

14 hours ago, mhupp said:

Updated your code a bit with comments.

 

 

 

 

thanks for your help!!

and I edit some of that 

 

(defun C:WIRE (/ str q a hlinks ss r s)
  (setvar "cmdecho" 0)
  (defun *error* ()  ;will stop the error when you hit esc
    (command nil nil nil)
    (if (not (member *error* '("Function cancelled")))
      (princ (strcat "\nError: " *error*))
    )
  )
  (while  ;gets rid of the (C:wire)'s
    (or (setq str (vlax-ldata-get "Tag" "str")) (setq str "N/A"))  ;ldata will persist when a drawing is saved.
    (or (setq q (vlax-ldata-get "Tag" "q")) (setq q "N/A"))        ;ldata persists even when variables are declared in the defun.
    (princ (strcat "\nPolyline Tag: " str " \\ Last Point: " (vl-princ-to-string q)))  ;can combine into one line with strcat.
    (initget "t w e l d")
    (setq a
      (cond
        ((getkword "\nWiring Tool [Changetag(t)/Draw(w)/Elevation(e)/ExistedPolyTagging(l)/DeleteTag(d)]:")) ( "w") ;defaults to w with right click or enter.
      )
    )
    (cond  ;cond is the better choice here
      ((= a "t")
        (setq str (getstring "\nChange Tag :"))
        (vlax-ldata-put "Tag" "str" str)  ;save value to ldata
      )
      ((= a "e")
        (if (and (setq r (getpoint "\nPick Point")) (setq s (getint "\nSet Elevation Length: ")))  ;runs once it was repeating s times
        (repeat s
          (progn
            (vlax-ldata-put "Tag" "q" r) ;maybe not needed?
            (command "._pline" r "a" "a" "180" "r" (/ 1 (* 2 pi )) "90" "r" (/ 1 (* 2 pi )) "a" "180" "-90" "") ; c was for close?
            (command "_.JOIN" ss (entlast) "")
            (setq ss (ssget "l" :s))
            (if ss
              (progn
                (setq obj (vlax-ename->vla-object (ssname ss 0)))
                (setq hlinks (vlax-get-property obj 'Hyperlinks))
                (vla-add hlinks str)
              )
            )
          )
        )
        )
      )
      ((= a "w")
        (prompt "\nDraw Polyline")
        (vl-cmdf "_.pline")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (command "_.JOIN" ss (entlast) "")
        (vlax-ldata-put "Tag" "q" (getvar 'lastpoint))
        (setq ss (ssget "l" :s))
        (if ss
          (progn
            (setq obj (vlax-ename->vla-object (ssname ss 0)))
            (setq hlinks (vlax-get-property obj 'Hyperlinks))
            (vla-add hlinks str)
          )
        )
      )
      ((= a "l")
        (prompt "\nDelete Selected Polyline's Tag")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (progn
           (if (setq ss (car (entsel "\nSelect entity.. ")))
               (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object ss)) (vla-delete x))
           )
        )
        (prompt "\nTag to Existed Polyline")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (setq ss (ssget :s))
        (if ss
           (progn
              (setq obj (vlax-ename->vla-object (ssname ss 0)))
              (setq hlinks (vlax-get-property obj 'Hyperlinks))
              (vla-add hlinks str)
            )
        )
      )
      ((= a "d")
        (prompt "\nDelete Selected Polyline's Tag")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (progn
           (if (setq ss (car (entsel "\nSelect entity.. ")))
               (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object ss)) (vla-delete x))
           )
        )
      )
     )

    )
  )
)

 

 

It is OK tag name is N/A when file open.

because everytime input tag name is more take time, so I delete getstring str at first time

 

Elevation(e) option is just for length.

ex) go up 10 meters > draw 1 meter shape in 2d plane x 10 times = 10 meters. so that I use (repeat s)

some of my friend use 3d2d(flatten) lisp out of habit. so I solve that way unfortunately. : )

 

I add _.join end of the draw.

for make one tag has one polyline (this is temporarily solution I think)

now no need to sumif in data-extraction excel file.

 

and add existed polyline naming and delete name option.

but that 2 option makes some problem

error message is "has too many Independent variable" but it works

how do I correct that?

 

Thank you again.

Link to comment
Share on other sites

I found error point. it has 1 more bracket :(

and add call-out function, listing polyline's hyperlink in simple text.

 

It works good👍👍

 

(defun C:WIRE (/ str q a hlinks ss r s x)
  (setvar "cmdecho" 0)
  (defun *error* ()  ;will stop the error when you hit esc
    (command nil nil nil)
    (if (not (member *error* '("Function cancelled")))
      (princ (strcat "\nError: " *error*))
    )
  )
  (while  ;gets rid of the (C:wire)'s
    (or (setq str (vlax-ldata-get "Tag" "str")) (setq str "N/A"))  ;ldata will persist when a drawing is saved.
    (or (setq q (vlax-ldata-get "Tag" "q")) (setq q "N/A"))        ;ldata persists even when variables are declared in the defun.
    (princ (strcat "\nPolyline Tag: " str " \\ Last Point: " (vl-princ-to-string q)))  ;can combine into one line with strcat.
    (initget "t w e l d c")
    (setq a
      (cond
        ((getkword "\nWiring Tool [Changetag(t)/Draw(w)/Elevation(e)/ExistedPolyTagging(l)/DeleteTag(d)/PlaceCallOut(c)]:")) ( "w") ;defaults to w with right click or enter.
      )
    )
    (cond  ;cond is the better choice here
      ((= a "t")
        (setq str (getstring "\nChange Tag :"))
        (vlax-ldata-put "Tag" "str" str)  ;save value to ldata
      )
      ((= a "e")
        (if (and (setq r (getpoint "\nPick Point")) (setq s (getint "\nSet Elevation Length: ")))  ;runs once it was repeating s times
        (repeat s
          (progn
            (vlax-ldata-put "Tag" "q" r) ;maybe not needed?
            (command "._pline" r "a" "a" "180" "r" (/ 1 (* 2 pi )) "90" "r" (/ 1 (* 2 pi )) "a" "180" "-90" "") ; c was for close?
            (command "_.JOIN" ss (entlast) "")
            (setq ss (ssget "l" :s))
            (if ss
              (progn
                (setq obj (vlax-ename->vla-object (ssname ss 0)))
                (setq hlinks (vlax-get-property obj 'Hyperlinks))
                (vla-add hlinks str)
              )
            )
          )
        )
        )
      )
      ((= a "w")
        (prompt "\nDraw Polyline")
        (vl-cmdf "_.pline")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (command "_.JOIN" ss (entlast) "")
        (vlax-ldata-put "Tag" "q" (getvar 'lastpoint))
        (setq ss (ssget "l" :s))
        (if ss
          (progn
            (setq obj (vlax-ename->vla-object (ssname ss 0)))
            (setq hlinks (vlax-get-property obj 'Hyperlinks))
            (vla-add hlinks str)
          )
        )
      )
      ((= a "l")
        (prompt "\nDelete Selected Polyline's Tag")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (progn
           (if (setq ss (car (entsel "\nSelect entity.. ")))
               (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object ss)) (vla-delete x))
           )
        )
        (prompt "\nTag to Existed Polyline")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (setq ss (ssget :s))
        (if ss
           (progn
              (setq obj (vlax-ename->vla-object (ssname ss 0)))
              (setq hlinks (vlax-get-property obj 'Hyperlinks))
              (vla-add hlinks str)
            )
        )
      )
      ((= a "d")
        (prompt "\nDelete Selected Polyline's Tag")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (progn
           (if (setq ss (car (entsel "\nSelect entity.. ")))
               (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object ss)) (vla-delete x))
           )
        )
      )
      ((= a "c")
        (while (> (getvar 'CmdActive) 0) (command pause))
        (progn
           (c:wirelist)
        )
      )
     

    )
  )
)

(defun c:WIRELIST ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize )
(setq r (getpoint "\nPick Point"))
(setq textsize (getvar 'textsize))
(if (and 

		(setq ss_dtl 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				
				(list "_:L"
					
					(append '((0 . "LWPOLYLINE,POLYLINE"))
						
						(
							
							(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")))

					)

				)
           
			)
	
		)
   
  
       )

       (progn
           
           (setq dtl_count 0)

           (repeat (sslength ss_dtl)
                                    (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
                                                            (command "text" r textsize "0" hyp_txt )
                                                            
		
				)


			(setq dtl_count (1+ dtl_count))

           )


       )

   )

(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)
)

 

 

 

Edited by exceed
code modify
Link to comment
Share on other sites

  • 1 month later...
(defun c:hsel ( / ss obj hlinks str n k en txt txten txtelist)
   (prompt "\n Select Object to Add Hyperlinks ")
   (setq ss (ssget ":L")) (terpri)
   (setq txten (car (entsel "\n Pick Text :")))
         (if txten
            (progn
               (setq txtelist (entget txten))
               (setq txt (cdr (assoc 1 txtelist)))
            ); progn
          ); if
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq en (ssname ss k))
       (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x))
       (setq n (- n 1))
       (setq k (+ k 1))
   )
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq obj (vlax-ename->vla-object (ssname ss k)))
       (setq hlinks (vlax-get-property obj 'Hyperlinks))
       (vla-add hlinks txt)
       (setq obj 0)
       (setq n (- n 1))
       (setq k (+ k 1))
   )
 (princ)
 )



(defun c:htxt ( / ss obj hlinks str n k en )
   (prompt "\n Select Object to Add Hyperlinks ")
   (setq ss (ssget ":L")) (terpri)
   (setq str (getstring "\n Input Text : "))
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq en (ssname ss k))
       (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x))
       (setq n (- n 1))
       (setq k (+ k 1))
   )
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq obj (vlax-ename->vla-object (ssname ss k)))
       (setq hlinks (vlax-get-property obj 'Hyperlinks))
       ;(setq str (getstring "\nEnter Hyperlink: "))
       (vla-add hlinks str)
       (setq obj 0)
       (setq n (- n 1))
       (setq k (+ k 1))
   )
 (princ)
 )



(defun c:hdel (/ ss n k en )
   (prompt "\n Select Object to delete Hyperlinks : ")
   (setq ss (ssget)) (terpri)
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq en (ssname ss k))
       (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x))
       (setq n (- n 1))
       (setq k (+ k 1))
   )
   (princ)
)




(defun C:TAG ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize linkUrl)
(setq r (getpoint "\nPick Point"))
(setvar 'CMDECHO 0)
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "INSERT,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "INSERT,LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))


    )

    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)
            (setq r (polar r (dtr 90) (* textsize 1.4)))
            (setq hyt_txt 0)
			(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)))
			)
			;(setq linkUrl (cdr (assoc 2 (entget (ssname ss_dtl dtl_count)))))
			;(setq linkUrl (vlax-vla-object->ename (vla-item dtl_hyp 0)))
                                    (command "text" r textsize "0" hyp_txt )
                                    ;(princ (vl-princ-to-string linkUrl))
			(setq dtl_count (1+ dtl_count))
        )
   ;(princ (vl-princ-to-string hyp_txt))
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
       

)
(setvar 'CMDECHO 1)
(princ)
)


(defun C:TAGL ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize len_txt )
(vl-load-com)
(setvar 'CMDECHO 0)
(setq r (getpoint "\nPick Point"))
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))

    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)
            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
			)
			(setq len_txt (rtos (vla-get-length dtl_obj) ) )
            		(command "text" r textsize "0" (strcat hyp_txt " / Length = " len_txt ))
			(setq dtl_count (1+ dtl_count))
                 )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)

(defun C:TAGLL ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize len_txt lay_txt )
(vl-load-com)
(setvar 'CMDECHO 0)
(setq r (getpoint "\nPick Point"))
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)
            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
			)
			(setq len_txt (rtos (vla-get-length dtl_obj) ) )
			(setq lay_txt (vla-get-layer dtl_obj) )
            		(command "text" r textsize "0" (strcat hyp_txt " / Length = " len_txt " / Layer = " lay_txt ))
			(setq dtl_count (1+ dtl_count))
        )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)


(defun C:TAGXYZ ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize xyz_txt lay_txt)
(setq r (getpoint "\nPick Point"))
(setvar 'CMDECHO 0)
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "INSERT,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "INSERT,LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)
            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
                                    (setq xyz_txt (vl-princ-to-string (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint dtl_obj)))))
			)
            (command "text" r textsize "0" (strcat hyp_txt " / Coord = " xyz_txt) )
			(setq dtl_count (1+ dtl_count))
        )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)

(defun C:TAGXYZL ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize xyz_txt)
(setq r (getpoint "\nPick Point"))
(setvar 'CMDECHO 0)
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "INSERT,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "INSERT,LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)

            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
                                    (setq xyz_txt (vl-princ-to-string (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint dtl_obj)))))
			(setq lay_txt (vla-get-layer dtl_obj) )
			)
                                    (command "text" r textsize "0" (strcat hyp_txt " / Coord = "  xyz_txt " / Layer = "  lay_txt))
			(setq dtl_count (1+ dtl_count))
        )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)



(defun C:TAGXYZLN ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize xyz_txt blkname_txt)
(setq r (getpoint "\nPick Point"))
(setvar 'CMDECHO 0)
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "INSERT,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "INSERT,LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)

            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
                                    (setq xyz_txt (vl-princ-to-string (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint dtl_obj)))))
			(setq lay_txt (vla-get-layer dtl_obj))
                                    (setq blkname_txt (vla-get-effectivename dtl_obj))
			)
                                    (command "text" r textsize "0" (strcat hyp_txt " / Coord = "  xyz_txt " / Layer = "  lay_txt " / BlockName = " blkname_txt ))
			(setq dtl_count (1+ dtl_count))
        )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)




;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(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)
)

 

little bit improvement for this code.

 

I use this custom polyline tool several days

I got to know that, add hyperlink after draw polyline normally, is more simple routine

 

- add hyperlinks

HTXT : Select Object -> Input Text 

HSEL : Select Object -> Select Text

 

- delete hyperlinks

HDEL : Select Object to Delete Hyperlinks

 

- call out for Polylines

TAG - Hyperlinks (tag no.) 

TAGL - TAG + Length

TAGLL - TAGL + Layer

 

- call out for blocks

TAG - Hyperlinks (tag no.)

TAGXYZ - TAG + coordinates of base point

TAGXYZL - TAGXYZ + layer

TAGXYZLN - TAGXYZL + block name (Type)

 

I study that add hyperlink function cannot overwrite the object already has existed hyperlink.

so add delete procedure before write procedure.

 

then add filter to TAG to select only those with hyperlinks.

 (setq ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))

because it has one problem. When polylines that do not have hyperlinks are mixed and selected, they are printed repeatedly.

 

 

then add option to tagging blocks TAGXYZ, TAGXYZL, TAGXYZLN

Using a block means that it is used repeatedly, in my works. want to block has individual name.

 

what's better than use XDATA.

hovering display and can see in properties without custom CUI. I think

I know that it is not used for its intended purpose. 😅

Edited by exceed
Link to comment
Share on other sites

(defun c:hsel ( / ss obj hlinks str n k en txt txten txtelist)
   (prompt "\n Select Object to Add Hyperlinks ")
   (setq ss (ssget ":L")) (terpri)
   (setq txten (car (entsel "\n Pick Text :")))
         (if txten
            (progn
               (setq txtelist (entget txten))
               (setq txt (cdr (assoc 1 txtelist)))
            ); progn
          ); if
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq en (ssname ss k))
       (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x))
       (setq n (- n 1))
       (setq k (+ k 1))
   )
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq obj (vlax-ename->vla-object (ssname ss k)))
       (setq hlinks (vlax-get-property obj 'Hyperlinks))
       (vla-add hlinks txt)
       (setq obj 0)
       (setq n (- n 1))
       (setq k (+ k 1))
   )
 (princ)
 )



(defun c:htxt ( / ss obj hlinks str n k en )
   (prompt "\n Select Object to Add Hyperlinks ")
   (setq ss (ssget ":L")) (terpri)
   (setq str (getstring "\n Input Text : "))
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq en (ssname ss k))
       (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x))
       (setq n (- n 1))
       (setq k (+ k 1))
   )
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq obj (vlax-ename->vla-object (ssname ss k)))
       (setq hlinks (vlax-get-property obj 'Hyperlinks))
       ;(setq str (getstring "\nEnter Hyperlink: "))
       (vla-add hlinks str)
       (setq obj 0)
       (setq n (- n 1))
       (setq k (+ k 1))
   )
 (princ)
 )



(defun c:hdel (/ ss n k en )
   (prompt "\n Select Object to delete Hyperlinks : ")
   (setq ss (ssget)) (terpri)
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq en (ssname ss k))
       (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x))
       (setq n (- n 1))
       (setq k (+ k 1))
   )
   (princ)
)




(defun C:TAG ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize linkUrl)
(setq r (getpoint "\nPick Point"))
(setvar 'CMDECHO 0)
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "INSERT,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "INSERT,LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))


    )

    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)
            (setq r (polar r (dtr 90) (* textsize 1.4)))
            (setq hyt_txt 0)
			(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)))
			)
			;(setq linkUrl (cdr (assoc 2 (entget (ssname ss_dtl dtl_count)))))
			;(setq linkUrl (vlax-vla-object->ename (vla-item dtl_hyp 0)))
                                    (command "text" r textsize "0" hyp_txt )
                                    ;(princ (vl-princ-to-string linkUrl))
			(setq dtl_count (1+ dtl_count))
        )
   ;(princ (vl-princ-to-string hyp_txt))
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
       

)
(setvar 'CMDECHO 1)
(princ)
)


(defun C:TAGL ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize len_txt )
(vl-load-com)
(setvar 'CMDECHO 0)
(setq r (getpoint "\nPick Point"))
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))

    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)
            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
			)
			(setq len_txt (rtos (vla-get-length dtl_obj) ) )
            		(command "text" r textsize "0" (strcat hyp_txt " / Length = " len_txt ))
			(setq dtl_count (1+ dtl_count))
                 )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)

(defun C:TAGLL ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize len_txt lay_txt )
(vl-load-com)
(setvar 'CMDECHO 0)
(setq r (getpoint "\nPick Point"))
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)
            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
			)
			(setq len_txt (rtos (vla-get-length dtl_obj) ) )
			(setq lay_txt (vla-get-layer dtl_obj) )
            		(command "text" r textsize "0" (strcat hyp_txt " / Length = " len_txt " / Layer = " lay_txt ))
			(setq dtl_count (1+ dtl_count))
        )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)


(defun C:TAGXYZ ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize xyz_txt lay_txt)
(setq r (getpoint "\nPick Point"))
(setvar 'CMDECHO 0)
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "INSERT,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "INSERT,LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)
            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
                                    (setq xyz_txt (vl-princ-to-string (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint dtl_obj)))))
			)
            (command "text" r textsize "0" (strcat hyp_txt " / Coord = " xyz_txt) )
			(setq dtl_count (1+ dtl_count))
        )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)

(defun C:TAGXYZL ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize xyz_txt)
(setq r (getpoint "\nPick Point"))
(setvar 'CMDECHO 0)
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "INSERT,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "INSERT,LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)

            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
                                    (setq xyz_txt (vl-princ-to-string (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint dtl_obj)))))
			(setq lay_txt (vla-get-layer dtl_obj) )
			)
                                    (command "text" r textsize "0" (strcat hyp_txt " / Coord = "  xyz_txt " / Layer = "  lay_txt))
			(setq dtl_count (1+ dtl_count))
        )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)



(defun C:TAGXYZLN ( / ss_dtl dtl_export dtl_export_open dtl_count dtl_obj dtl_hyp each hyp_txt r textsize xyz_txt blkname_txt)
(setq r (getpoint "\nPick Point"))
(setvar 'CMDECHO 0)
(setq textsize (getvar 'textsize))
(if (and 

			(LM:ssget "\nSelect details in order for export or [Fence]: "
				(list "_:L"
					(append '((0 . "INSERT,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "INSERT,LWPOLYLINE,POLYLINE" (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 ss_dtl (ssget "_P" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
    )
    (progn
        (setq dtl_count 0)
        (repeat (sslength ss_dtl)

            (setq r (polar r (dtr 90) (* textsize 1.4)))
			(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)))
                                    (setq xyz_txt (vl-princ-to-string (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint dtl_obj)))))
			(setq lay_txt (vla-get-layer dtl_obj))
                                    (setq blkname_txt (vla-get-effectivename dtl_obj))
			)
                                    (command "text" r textsize "0" (strcat hyp_txt " / Coord = "  xyz_txt " / Layer = "  lay_txt " / BlockName = " blkname_txt ))
			(setq dtl_count (1+ dtl_count))
        )
   (princ (strcat "\nHyperlink Count : " (vl-princ-to-string dtl_count) " EA\n"))
    )
)
(setvar 'CMDECHO 1)
(princ)
)


(defun c:HMAT ( / ss obj hlinks str n k en ss1 ss1_obj ss1_hyp ss1_txt)
   (prompt "\n Select original to copy Hyperlink (single selection) ")
   (setq ss1 (ssget ":S")) (terpri)
   (setq ss1_obj (vlax-ename->vla-object (ssname ss1 0)))
   (setq ss1_hyp (vlax-get-property ss1_obj 'Hyperlinks))
   (vlax-for each ss1_hyp
	(setq ss1_txt (strcat (vla-get-url each)))
   )
   (prompt "\n Select object to paste Hyperlink ")
   (setq ss (ssget ":L")) (terpri)
   (setq str ss1_txt)
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq en (ssname ss k))
       (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x))
       (setq n (- n 1))
       (setq k (+ k 1))
   )
   (setq n (sslength ss))
   (setq k 0)
   (while (<= 1 n)
       (setq obj (vlax-ename->vla-object (ssname ss k)))
       (setq hlinks (vlax-get-property obj 'Hyperlinks))
       ;(setq str (getstring "\nEnter Hyperlink: "))
       (vla-add hlinks str)
       (setq obj 0)
       (setq n (- n 1))
       (setq k (+ k 1))
   )
 (princ)
 )



(defun c:FH( / *error* old_osmode fhclayer ob count inputtext bas name xxlist enti1 enti2 dxy x xx y yy finded num hyp_obj hyp_hyp text2 )

(command "ucs" "w")
(command "_undo" "_be")
(defun *error*(e)
(setvar "osmode" old_osmode)
(command "_undo" "_e")
(princ)
)
 (setvar "cmdecho" 0)
 (setq old_osmode 0)
 (setq fhclayer 0)
 (setq ob 0)
 (setq count 0)
 (setq inputtext 0)
 (setq bas 0)
 (setq name 0)
 (setq xxlist 0)
 (setq enti1 0)
 (setq enti2 0)
 (setq dxy 0)
 (setq x 0)
 (setq xx 0)
 (setq y 0)
 (setq yy 0)
 (setq xy 0)
 (setq finded 0)
 (setq num 0)
 
 (setq old_osmode (getvar "osmode")) 
 (setq fhclayer (getvar "clayer"))
 (setq ob (ssget "x" '((0 . "INSERT,LWPOLYLINE,POLYLINE") (-3 ("PE_URL")) )))
 (setq count (sslength ob))
 (setq inputtext (getstring T "\n Input Hyperlink to Find "))
 (setq bas (getpoint "\n Pick point to set origin "))
 (setq num 0)
 (setq finded 0)
 (setvar "osmode" 0)
 (if (= bas nil) (setq bas "0, 0"))
   (repeat count
    (setq name (ssname ob num))
    (setq xxlist (entget name))
     (progn
       (setq enti1  (cdr (assoc -1 xxlist)))
       ;(setq text2  (cdr (assoc 1 xxlist)))
       (setq hyp_obj (vlax-ename->vla-object name))
       (setq hyp_hyp (vlax-get-property hyp_obj 'Hyperlinks))
            (vlax-for each hyp_hyp 
	      (setq text2 (strcat (vla-get-url each)))
	)
       (setq dxy (assoc 10 xxlist))
       (setq x (nth 1 dxy))
       (setq xx (rtos x 2 4))
       (setq y (nth 2 dxy))
       (setq yy (rtos y 2 4))
       (setq xy (strcat xx "," yy))
       (if (wcmatch (strcase text2) (strcat "*" (strcase inputtext) "*"))
        (progn
         (command "pline" bas xy "")
         (setq finded (+ finded 1))
        );progn
       );if
      );progn
     (setq num (+ num 1))
    );repeat
(prompt (strcat "\n Hyperlink Total = "(rtos finded) " ea"))
(if ( = finded 0 ) (alert " There's no Hyperlink"))
(command "_undo" "_e")
(setvar "osmode" old_osmode)
(princ)
(command "ucs" "p")
(princ)
);end_defun


;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(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)
)

 

 

add Hyperlink Match ( HMAT )

add Find Hyperlink Function for block, polyline only ( FH ) use old find text and draw lines lisp (allow space bar, and use both side wildcard)

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...