Leaderboard

Better to provide a link to give credit to the author Kent Cooper which would be the source if anyone had any questions about the lisp. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-subfunction-to-get-quot-center-quot-inside-closed-polyline/m-p/8747852#M384196

hello @Steven P, yes it worked for me, thanks a lot , you are someone like a superman or hero :))))))

Aha, copy and paste, love it.... (probably shorter ways of doing this, just copied from other stuff) Try this (and hope I copied and pasted everything I needed to - if not post back here with any error messages hat the command line gives) (defun SetClipBoardText ( MyText / htmlfile result ) (vlax-invoke (vlax-get (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" Mytext) (vlax-release-object htmlfile) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gettextdxfcodes ( entlist1 / dxfcodes) ;;DXF codes containing texts (setq dxfcodes (list 3 4 1 172 304)) ;;general (if (= (cdr (assoc 0 entlist1)) "DIMENSION") ;;If Dimension (progn (if (= (cdr (assoc 1 entlist1)) nil) (setq dxfcodes (list 4 42 172 304)) ;;No 3, add 42 for dimension value (if (and (= (wcmatch "<>" (cdr (assoc 1 entlist1))) nil)(= (wcmatch "\"\"" (cdr (assoc 1 entlist1))) nil) ) (setq dxfcodes (list 4 1 172 304)) ;;No 3, no 42 for dimension value (setq dxfcodes (list 4 1 42 172 304)) ;;Somehow combine 1 and 42 here, text replace and so on. ) ;end if ) ;end if ));end progn end if Dimensions (if (= (cdr (assoc 0 entlist1)) "MULTILEADER") ;;Is MultiLeader (progn (setq dxfcodes (list 304)) ));end progn end if Dimensions dxfcodes ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext) ;;get dotted pairs list (setq entlist (entget ent)) (setq enttype (cdr (assoc 0 entlist))) (setq acount 0) (while (< acount (length entlist)) (setq acounter 0) (while (< acounter (length entcodes)) (setq entcode (nth acounter entcodes)) (if (= (car (nth acount entlist)) entcode ) (progn (setq newtext (cdr (nth acount entlist))) (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) ) );end progn );end if (setq acounter (+ acounter 1)) );end while (setq acount (+ acount 1)) );end while ;;get string from dotted pair lists (if (= listorstring "astring") ;convert to text (progn (if (> (length mytext) 0) (progn (setq acount 0) (setq temptext "") (while (< acount (length mytext)) (setq temptext (cdr (nth acount mytext)) ) (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text (if (= stringtext nil) (setq stringtext temptext) (setq stringtext (strcat stringtext temptext )) );end if (setq acount (+ acount 1)) );end while );end progn );end if (if (= stringtext nil)(setq stringtext "")) (setq mytext stringtext) );end progn );end if mytext ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun C:ST (/ txt ss typ) (if (eq (setq txt (strcase (getstring "\nSearch for Text [Area]: "))) "");hit enter for defult options. (setq txt "AREA") ;set defult search options here ) (if (setq ss (ssget "_X" (list '(0 . "MTEXT,TEXT,MULTILEADER,DIMENSION") (cons 410 (getvar 'ctab))))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq typ (cdr (assoc 0 (entget ent)))) (cond ((member typ '("TEXT" "MTEXT" "MULTILEADER")) (setq obj (vlax-ename->vla-object ent)) ;convert to val-object (if (vl-string-search txt (strcase (vlax-get obj 'TextString))) (progn) ;if found leave in selection set (ssdel ent ss) ;if not found in string remove from selection s ) ; end if ) ; end cond 1 ((eq typ "DIMENSION") (setq obj (vlax-ename->vla-object ent)) ;convert to val-object (if (vl-string-search txt (strcase (vlax-get obj 'TextOverride))) (progn) ;if found leave in selection set (ssdel ent ss) ;if not found in string remove from selection s ) ;end if ) ; end cond 2 ) ; end conds ) ; end for each ) ; end if (if (> (sslength ss) 1) ;if anything is still in the selection set (progn (prompt (strcat "\n" (itoa (sslength ss)) " Entitys containing \"" txt "\"")) (sssetfirst nil ss) ) ; end progn (prompt (strcat "\n" txt "Not Found in Drawing")) ) ; end if (setq myent (ssname ss 0)) (setq entlist1 (entget myent)) (setq entcodes (gettextdxfcodes entlist1) ) (setq texta (getfroment myent "astring" entcodes)) (setq Selectedtexts nil) (setq acount 0) (while ( < acount (sslength ss)) (if (= nil Selectedtexts) (progn (setq myent (ssname ss acount)) (setq entlist1 (entget myent)) (setq entcodes (gettextdxfcodes entlist1)) (setq texta (getfroment myent "astring" entcodes)) (setq Selectedtexts texta) ) (progn (setq myent (ssname ss acount)) (setq entlist1 (entget myent)) (setq entcodes (gettextdxfcodes entlist1)) (setq texta (getfroment myent "astring" entcodes)) (setq Selectedtexts (strcat Selectedtexts (chr 10) texta)) ) ) (setq acount (+ acount 1)) ) ; end while (SetClipBoardText Selectedtexts) (princ Selectedtexts) (princ) )

You do realize the reason for the lisp is because it isn't possible to create a hatch like this?

It is always a pity when negative feedback is posted about something that was given freely. The phrase 'looking a gift horse in the mouth' springs to mind. Did you read the working parameters at the beginning of the lisp file? Just open the file in a text reader, and you will see that the outcome is not a hatch. So how can you think that the scale can be altered? Perhaps you are voicing your discontent that the lisp does not do what you think it ought to do!

It didn't solve world hunger either!

Thank you so very much GP_ and Gu_xl for sharing a fantastic program. Sorry my "thanks" are 10 years late but I didn't see this the first time around. Truly great programming! I have already added to my toolbox.

Hi, Something like this? (defun c:Test (/ *error* int sel ent get ovr csv opn ) ;; Tharwat - 29.Jul.2021 ;; (defun *error* (msg) (and opn (close opn)) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*BREAK*")) (princ (strcat "\nError =>: " msg))) (princ "\nThis AutoLISP program was written by Tharwat Al Choufi") ) (and (setq int -1 sel (ssget '((0 . "*DIMENSION")))) (setq csv (getfiled "Save as ..." (getvar 'DWGPREFIX) "csv" 1)) (setq opn (open csv "w")) (write-line (strcat "Text Override" "," "Measurement") opn) (while (setq int (1+ int) ent (ssname sel int)) (setq get (entget ent)) (write-line (strcat (if (= (setq ovr (cdr (assoc 1 get))) "") "Null" ovr) "," (vl-princ-to-string (cdr (assoc 42 get)))) opn ) ) ) (*error* nil) (princ) ) (vl-load-com)