Jump to content

Detect duplicate text (entmake polyline question)

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted 
(defun c:DFT( / *error* seltxt selcount selnum old_osmode imsi ob count a5 bas name xxlist enti1 enti2 dxy x xx y yy xy finded num pcolor seldxy selx selxx sely selyy selxy )
(command "ucs" "w")
(command "_undo" "_be")
(defun *error*(e)
(command "_undo" "_e")
(princ)
)
 (setvar "cmdecho" 0)
 (setq old_osmode (getvar "osmode")) 
 (setq imsi (getvar "clayer"))
 (setq scolor 1)

 (setq seltxt (ssget '((0 . "text,mtext"))))
 (setq selcount (sslength seltxt))
 (setq selnum 0)
 (setq finded 0)
(repeat selcount
 (setq ob (ssget "x" '((0 . "text,mtext"))))
 (setq count (sslength ob))
 (setq a5 (cdr (assoc 1 (entget (ssname seltxt selnum)))))
 (setq seldxy (assoc 10 (entget (ssname seltxt selnum))))
 (setq selx (nth 1 seldxy))
 (setq selxx (rtos selx 2 4))
 (setq sely (nth 2 seldxy))
 (setq selyy (rtos sely 2 4))
 (setq bas (strcat selxx "," selyy))

 (setq num 0)
 (setvar "osmode" 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 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 (LM:UnFormat text2 nil))(strcat "*" (strcase (LM:UnFormat a5 nil)) "*"))
         (if (/= seldxy dxy)
         (progn
         (command "pline" bas xy "")
         (vlax-put-property (vlax-ename->vla-object (entlast)) "Color" scolor)
         (setq finded (+ finded 1))
         );progn
         );if
       );if
      );progn
     (setq num (+ num 1))
    );repeat
 (setq selnum (+ selnum 1))
 (setq scolor (+ scolor 1))
);repeat
(prompt (strcat "\n The number of duplicate texts = " (rtos finded) " ea"))
(if ( = finded 1 ) (alert "There's no duplicated texts."))

(command "_undo" "_e")
(setvar "osmode" old_osmode)
(princ)
(command "ucs" "p")
(princ)
);end_defun



;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ⓒ 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)

 

I edit a Lisp that draws lines on duplicate texts

by slightly modifying find text then draw line lisp.

 

It works successfully,

886497458_2022-01-09174150.PNG.db5cd785b90c49d9b875d063b4ff15df.PNG

 

1332256186_2022-01-09164056.thumb.PNG.46a79bdbe5c34bfe0256343fbf0a5e41.PNG

 

 

but it is too slow.

so, I try to make it by entmake. instead of command

  

(defun c:DFT( / *error* seltxt selcount selnum old_osmode ob count a5 bas name xxlist enti1 enti2 dxy x xx y yy xy finded num pcolor seldxy selx selxx sely selyy selxy )
 (setvar "cmdecho" 0)
(command "ucs" "w")
(command "_undo" "_be")
(defun *error*(e)
(command "_undo" "_e")
(princ)
)

 (setq old_osmode (getvar "osmode")) 
 (setvar "osmode" 0)
 (setq scolor 1)

 (setq seltxt (ssget '((0 . "text,mtext"))))
 (setq selcount (sslength seltxt))
 (setq selnum 0)
 (setq finded 0)

 (setq ob (ssget "x" '((0 . "text,mtext"))))
 (setq count (sslength ob))

(repeat selcount
 (setq a5 (cdr (assoc 1 (entget (ssname seltxt selnum)))))
 (setq seldxy (assoc 10 (entget (ssname seltxt selnum))))
 (setq selx (nth 1 seldxy))
 (setq selxx (rtos selx 2 4))
 (setq sely (nth 2 seldxy))
 (setq selyy (rtos sely 2 4))
 (setq bas (strcat selxx "," selyy))

 (setq num 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 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 (LM:UnFormat text2 nil))(strcat "*" (strcase (LM:UnFormat a5 nil)) "*"))
         (if (/= seldxy dxy)
         (progn


         (setq pointlist (list dxy seldxy))
         (princ pointlist)
         (LWPoly pointlist 1)

        ;(command "pline" bas xy "")
         (vlax-put-property (vlax-ename->vla-object (entlast)) "Color" scolor)
         (setq finded (+ finded 1))
         );progn
         );if
       );if
      );progn
     (setq num (+ num 1))
    );repeat
 (setq selnum (+ selnum 1))
 (setq scolor (+ scolor 1))
);repeat
(prompt (strcat "\n The number of duplicate texts = " (rtos finded) " ea"))
(if ( = finded 0 ) (alert "There's no duplicated texts."))

(command "_undo" "_e")
(setvar "osmode" old_osmode)
(princ)
(command "ucs" "p")
(princ)


);end_defun



;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ⓒ 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)




(defun LWPoly (lst cls) ; LM's entmake functions
 (entmakex 
   (append 
     (list 
       (cons 0 "LWPOLYLINE")
       (cons 100 "AcDbEntity")
       (cons 100 "AcDbPolyline")
       (cons 90 (length lst))
       (cons 70 cls)
     )
     (mapcar (function (lambda (p) (cons 10 p))) lst)
   )
 )
)

 

but I failed.....

what is my fault?

 

 

Thanks for reading. late but happy new year!

 

Steven P Grand Master

Steven P

Posted
Posted

So when you were trying to work out what was going wrong, what did you find - it will save us all a little time if you don't end with "this doesn't work" but if you can add details such as "this doesn't work and  think this is the problem"

 

For example, does it call the LWPoly routine OK?.. working out where it all goes wrong. If it does then just put a temporary line in there "(princ lst)" to check what values are being passed to it, suspect that will give you the answer.....

  • Like 1
exceed Proficient

exceed

Posted
  • Author
Posted
5 hours ago, Steven P said:

So when you were trying to work out what was going wrong, what did you find - it will save us all a little time if you don't end with "this doesn't work" but if you can add details such as "this doesn't work and  think this is the problem"

 

For example, does it call the LWPoly routine OK?.. working out where it all goes wrong. If it does then just put a temporary line in there "(princ lst)" to check what values are being passed to it, suspect that will give you the answer.....

 

That's correct. I'm sorry to about that.

 

I misunderstood that the coordinates obtained by (assoc 10) in the text, are "points".

As you said, when I (princ), there was a 10 value in the front. ((10 xxxx yyyy zzzz)(10 xxxx yyyy zzzz)(10 xxxx yyyy zzzz))

So, I modified the code as follows, and it succeeded. thank you very much

  

(defun c:DFT( / *error* seltxt selcount selnum old_osmode ob count a5 bas name xxlist enti1 enti2 dxy x xx y yy xy finded num pcolor seldxy selx selxx sely selyy selxy )
 (setvar "cmdecho" 0) 
 (command "ucs" "w") 
 (command "_undo" "_be")
   (defun *error*(e)
     (command "_undo" "_e")
     (princ)
   )

 (setq old_osmode (getvar "osmode")) 
 (setvar "osmode" 0)
 (setq scolor 1) ;set line's default color

 (setq seltxt (ssget '((0 . "text,mtext")))) 
 (setq selcount (sslength seltxt)) 
 (setq selnum 0) 
 (setq finded 0)

 (setq ob (ssget "x" '((0 . "text,mtext")))) 
 (setq count (sslength ob)) 

(repeat selcount 
 (setq a5 (cdr (assoc 1 (entget (ssname seltxt selnum)))))
 (setq seldxy (assoc 10 (entget (ssname seltxt selnum))))
 (setq selx (nth 1 seldxy)) 
 (setq sely (nth 2 seldxy))
 (setq seldxypoint (list selx sely)) 

 (setq num 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 dxy (assoc 10 xxlist))
       (setq x (nth 1 dxy))
       (setq y (nth 2 dxy))
       (setq dxypoint (list x y))
      
       (if (wcmatch (strcase (LM:UnFormat text2 nil))(strcat "*" (strcase (LM:UnFormat a5 nil)) "*"))

         (if (/= seldxy dxy)
           (progn
             (setq pointlist (list dxypoint seldxypoint))
             (LWPoly pointlist 0)

             (vlax-put-property (vlax-ename->vla-object (entlast)) "Color" scolor)
             (setq finded (+ finded 1))
           );progn
         );if
       );if
      );progn
     (setq num (+ num 1))
    );repeat
 (setq selnum (+ selnum 1))
 (setq scolor (+ scolor 1))
);repeat

(prompt (strcat "\n The number of duplicate texts = " (rtos finded) " ea"))
(if ( = finded 0 ) (alert "There's no duplicated texts."))

(command "_undo" "_e")
(setvar "osmode" old_osmode)
(princ)
(command "ucs" "p")
(princ)


);end_defun



;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ⓒ 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)




(defun LWPoly (lst cls) ; LM's entmake functions
 (entmakex 
   (append 
     (list 
       (cons 0 "LWPOLYLINE")
       (cons 100 "AcDbEntity")
       (cons 100 "AcDbPolyline")
       (cons 90 (length lst))
       (cons 70 cls)
     )
     (mapcar (function (lambda (p) (cons 10 p))) lst)
   )
 )
)

 

 

  • Like 1
Steven P Grand Master

Steven P

Posted
Posted

No problem, sometimes you can look at a problem too long and you need a fresh of eyes to see what is happening

  • Like 1
mhupp Grand Master

mhupp

Posted
Posted (edited)

Did you code in lisp before signing up here? because your killing it. With my text find lisp it only does one at a time so the screen doesn't get to cluttered. tho the changing of color is a nice touch. one note is that  the dxf code 10 in AutoCAD only shows cords if its left justification. all other justifications the point are in 11, and 10 becomes (0 0 0)  or nil.

 

Also look at this post from ronjonp its changed how it search for things. basically builds a list in memory then steps thought them.

 

Use these to dump properties of entity's in cad. 

;;----------------------------------------------------------------------------;;
;; Dump all methods and properties for selected objects               
(defun C:VDumpIt (/ ent)
  (if (setq SS (ssget))
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (vlax-Dump-Object (vlax-Ename->Vla-Object ent) t)
    )
  )
  (textscr)
  (princ)
)
;;----------------------------------------------------------------------------;;
;; Dump all DXF Group Data             
(defun c:DumpIt (/ e)
  (if (setq SS (ssget))
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (mapcar 'print (entget ent '( "*")))
    )
  )
  (textscr)
  (princ)
)
;;---------------------------

 

 

Edited by mhupp
  • Like 1
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Just a random idea if speed is problem maybe look at using lists rather than comparing within selection sets, the list would be a simple ((string pointxyz) then vl-sort so a new list would be made that is the strings in order in the list. (("string1" pointxyz)("string1" pointxyz) ("string2" pointxyz)...

 

I know over at Theswamp there has been a number of posts about manipulating lists into matching sublist using mapcar which is very fast, so maybe the end result is a ((point1 point2 point3)(point4 point5)....the list can be passed  to the entmake a pline.

 

If talking micro seconds then why convert XYZ to XY ? if 3d than can do 3dpline.

Edited by BIGAL
  • Like 1
exceed Proficient

exceed

Posted
  • Author
Posted (edited)
On 1/10/2022 at 7:32 AM, mhupp said:

one note is that  the dxf code 10 in AutoCAD only shows cords if its left justification. all other justifications the point are in 11, and 10 becomes (0 0 0)  or nil.

 

So first get the value of 11, and in the case of (11 0 0 0) then get the value of 10

 

oh, magic-spell mapcar and lambda....  it's still too hard for me,

but I now know roughly what it means. Maybe.. I will study it, thanks for link

 

and dumpit routine is good, It seems necessary to select the essential among them.

 

 

 

On 1/10/2022 at 7:39 AM, BIGAL said:

Just a random idea if speed is problem maybe look at using lists rather than comparing within selection sets, the list would be a simple ((string pointxyz) then vl-sort so a new list would be made that is the strings in order in the list. (("string1" pointxyz)("string1" pointxyz) ("string2" pointxyz)...

 

I know over at Theswamp there has been a number of posts about manipulating lists into matching sublist using mapcar which is very fast, so maybe the end result is a ((point1 point2 point3)(point4 point5)....the list can be passed  to the entmake a pline.

 

If talking micro seconds then why convert XYZ to XY ? if 3d than can do 3dpline.

If first sort the list and draw a line between the coordinates with the same first value,

It would be faster. I'll search that.

 

just I did not know how to put the assoc 10 value in entmake, so I converted it

 

 

within my understanding, slightly more edited

I use the easy way. line instead of 3dpoly for z-value.

If I use vl-sort list, there will be multiple vertices, then I will have to use 3dpoly.

 

and add hyperlinks for those lines. for mouse hovering to know what I found. (it will slow it down maybe)

1629604496_2022-01-10125335.PNG.1ef3fad61bf5eaf10011616a60cb5acf.PNG

 

and Move ssget before command ucs, so that it can be selected and executed first. 

(defun c:DFT( / *error* seltxt selcount selnum old_osmode ob count a5 bas name xxlist enti1 enti2 dxy x xx y yy xy finded num pcolor seldxy selx selxx sely selyy selxy )
 (setvar "cmdecho" 0) 
 (setq seltxt (ssget '((0 . "text,mtext"))))
 (command "ucs" "w") 
 (command "_undo" "_be")
   (defun *error*(e)
     (command "_undo" "_e")
     (princ)
   )

 (setq old_osmode (getvar "osmode")) 
 (setvar "osmode" 0)
 (setq scolor 1) ;set line's default color


 (setq selcount (sslength seltxt)) 
 (setq selnum 0) 
 (setq finded 0)

 (setq ob (ssget "x" '((0 . "text,mtext")))) 
 (setq count (sslength ob)) 

(repeat selcount 
 (setq a5 (cdr (assoc 1 (entget (ssname seltxt selnum)))))
 (setq seldxy (assoc 11 (entget (ssname seltxt selnum))))
 (if (= seldxy '(11 0 0 0)) (setq seldxy (assoc 10 (entget (ssname seltxt selnum)))) )

 (setq selx (nth 1 seldxy)) 
 (setq sely (nth 2 seldxy))
 (setq selz (nth 3 seldxy))

 (setq num 0) 

   (repeat count
    (setq name (ssname ob num))
    (setq xxlist (entget name))
     (progn
       (setq text2  (cdr (assoc 1 xxlist)))
       (setq dxy (assoc 11 xxlist))
       (if (= dxy '(11 0 0 0)) (setq dxy (assoc 10 xxlist)) )
       (setq x (nth 1 dxy))
       (setq y (nth 2 dxy))
       (setq z (nth 3 dxy))

       (if (wcmatch (strcase (LM:UnFormat text2 nil))(strcat "*" (strcase (LM:UnFormat a5 nil)) "*"))

         (if (/= seldxy dxy)
           (progn
             (setq pointlist (list dxypoint seldxypoint))
             
	 (entmake (list (cons 0 "LINE") 
	                  (cons 10 (list selx sely selz))
                              (cons 11 (list x y z))
                          )
             )

             (vlax-put-property (vlax-ename->vla-object (entlast)) "Color" scolor) ;set color
             (vla-add (setq hlinks (vlax-get-property (vlax-ename->vla-object (entlast)) 'Hyperlinks)) text2) ;put hyperlink

             (setq finded (+ finded 1))
           );progn
         );if
       );if
      );progn
     (setq num (+ num 1))
    );repeat
 (setq selnum (+ selnum 1))
 (setq scolor (+ scolor 1))
);repeat

(prompt (strcat "\n The number of duplicate texts = " (rtos finded) " ea"))
(if ( = finded 0 ) (alert "There's no duplicated texts."))

(command "_undo" "_e")
(setvar "osmode" old_osmode)
(princ)
(command "ucs" "p")
(princ)


);end_defun



;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ⓒ 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)



(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 . "LINE,LWPOLYLINE,POLYLINE"))
						(
							(lambda ( / def lst )
    							(while (setq def (tblnext "LINE,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 . "LINE,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)
)

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

 

 


In my work example.

About 10 tags belong to jb, and there are many such groups.

Text Spread from Excel or manually, 

place "tag name(jb name)" to tag's place. then place "jb" manually

then DFT to draw lines

and TAGLL to export line's name(hyperlink), length, layer like this.

1997959019_2022-01-10124517.thumb.PNG.a1585b4665dc5e8fae9873ab6bd73ba3.PNG

 

 

 

 

 

Edited by exceed

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.

×
 Share
Go to topic listing
×
×
  • Create New...