Leaderboard

ah yes. https://www.cadtutor.net/forum/topic/98598-just-a-funny-basic-toolbar/

Try this also. Seemed to work and makes a vector list code of objects. VECTORIZE.lsp

That would be The Dragon, RLX maybe? He had a menu but not sure if that is the one you're thinking off? (I was impressed but been too busy this year to get into using it)

Didn't someone have a lisp that created a menu system in model space ? on the right side of the current view.

Still starting from the mhupp code, I think this corresponds to your request: align all the blocks to the position of a block. Same for text or mtext. (defun C:ABC ( / vars vals ss ssref pt_ref pt2 vector mode ent ed pt newpt) (vl-load-com) (setq vars '(OSMODE ORTHOMODE) vals (mapcar 'getvar vars) ) (mapcar 'setvar vars '(0 1)) (princ "\nSelect Block or Texte.") (while (null (setq ss (ssget '((0 . "*TEXT,INSERT")))))) (princ "\nSelect ONE texte or block to align selection") (while (null (setq ssref (ssget "_+.:E:S" '((0 . "*TEXT,INSERT")))))) (setq pt_ref (cdr (assoc 10 (entget (ssname ssref 0))))) (setq pt2 (getpoint pt_ref "\nSelect Horozontal or Vertical:")) (setq vector (mapcar '- pt2 pt_ref)) (if (eq (car Vector) 0.0) (setq mode 'V) (setq mode 'H)) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq ed (entget ent) pt (cdr (assoc 10 ed)) newpt (if (eq mode 'V) (list (car pt_ref) (cadr pt) (caddr pt)) (list (car pt) (cadr pt_ref) (caddr pt))) ) (vla-Move (vlax-ename->vla-object ent) (vlax-3d-point pt) (vlax-3d-point newpt)) ) (mapcar 'setvar vars vals) (princ) )

Good day I would like to share this lisp for anyone need it Regards extcoord-extract_coords of anything -REV20.lsp

From HERE. Also mentioned in that post was Terry Millers GetVectors, but he has a new site now. AutoLISP Code

You could try these, the first one, test, will return lists for each line with the 4 values for the 2 end points (x1, y1, x2, y2). You need to also select a reference point to measure these points to. I tend to draw the thumbnail in a 75x75 square, reference point is top left corner and all the thumbnail entities are lines - nothing else - function name test The second one I haven't adjusted, copied straight from my library, blockthumbrecord, select the lines, select the reference point and it will return some results in a new notepad window... so not been adjusted you might need to add a function in there (LM: functions from Lee Macs website). Also the notepad will add in other stuff that is handy for me - a good learning exercise to look at the code and adjust it so it works for you. Both will give you sets of points for each line in a selection which you can copy and paste for your needs. Note that the vector graphics cannot do fractions, so maybe best set your snaps and grid to '1' and to get a smooth curve, a few short lines and make sure that the ends all touch. (defun c:test ( / ) (defun LM:round ( n ) (fix (+ n (if (minusp n) -0.5 0.5))) ) (princ "\nSelect LINES for thumbnail: ") ;;Get entities (setq ss (ssget '((0 . "LINE")))) (if (not ss) ;check for nil selection set (progn (princ "Nothing selected.") (exit) ) ;end progn ) ;end if ;;get list of entities (setq LinesList (list)) (setq acount 0) (setq BasePoint (getpoint "\Select Top Left Corner of Tumbnail (75x75 square)")) (setq BasePoint (reverse (cdr (reverse BasePoint)))) (while (< acount (sslength ss)) ;loop for every entity in the set (setq en (ssname ss acount)) ;get entity name (setq ed (entget en)) ;get entity definition (setq pt1 (reverse (cdr (reverse (cdr (assoc 10 ed)))))) ;; X and Y only (setq pt1 (mapcar '- BasePoint pt1)) ;; Shift by basepoint (setq pt1 (mapcar 'LM:round (mapcar 'abs pt1))) ;; Absolute value rounded to nearest 1 (setq pt1 (list (rtos (car pt1) 2 0) (rtos (cadr pt1) 2 0) )) ;; List items to strings (setq pt2 (reverse (cdr (reverse (cdr (assoc 11 ed)))))) ;; X and y Only (setq pt2 (mapcar '- BasePoint pt2)) ;; Shift by basepoint (setq pt2 (mapcar 'LM:round (mapcar 'abs pt2))) ;; Absolute value rounded to nearest 1 (setq pt2 (list (rtos (car pt2) 2 0) (rtos (cadr pt2) 2 0) )) ;; List items to strings (setq pt1 (append pt1 pt2)) ;; Create thumbnail definition line (setq LinesList (append LinesList (list pt1)) ) ;; Add definition line to thumb. definition (setq acount (+ acount 1)) ) ;;end while LinesList ) (defun c:blockThumbrecord ( / ss LinesList acount en ed pt1 pt2 tempblock f ) ;;Opens notepad wth lines coordinates (defun LM:lst->str ( lst del / str ) (setq str (car lst)) (foreach itm (cdr lst) (setq str (strcat str del itm))) str ) ;;Get entities (setq ss (ssget '((0 . "LINE")))) (if (not ss) ;check for nil selection set (progn (princ "Nothing selected.") (exit) ) ;end progn ) ;end if ;;get list of entities (setq LinesList (list)) (setq acount 0) (while (< acount (sslength ss)) ;loop for every entity in the set (setq en (ssname ss acount)) ;get entity name (setq ed (entget en)) ;get entity definition (setq pt1 (cdr (assoc 10 ed))) (setq pt1 (list "list" (rtos (abs (car pt1)) 2 0) (rtos (abs (cadr pt1)) 2 0) )) (setq pt2 (cdr (assoc 11 ed))) (setq pt1 (append pt1 (list (rtos (abs (car pt2)) 2 0) (rtos (abs (cadr pt2)) 2 0) "TxCol"))) (setq LinesList (append LinesList (list pt1)) ) (setq acount (+ acount 1)) ) ;;end while ;;write to a temp file (if (strcat (getvar "TEMPPREFIX") "Thumbnail.txt")(vl-file-delete (strcat (getvar "TEMPPREFIX") "Thumbnail.txt"))) (setq tempblock (strcat (getvar "TEMPPREFIX") "Thumbnail.txt")) ;;add check if this exists (setq f (open tempblock "w")) ;;open file (write-line " (Defun Sel--**FUNCTIONNAME**-- ( origin BgCol TxCol ImgTile Control / BlkList return) " f) (write-line " (if (= Control \"Vector\") " f) (write-line " (progn " f) (write-line " (start_image ImgTile) " f) (write-line " (fill_image (- origin 0) 0 (+ origin 85) 85 BgCol) " f) (write-line " (setq BlkList (list " f) (setq acount 0) (while (< acount (length LinesList)) (write-line (strcat "(" (LM:lst->str (nth acount LinesList) " ") ")" ) f) (setq acount (+ acount 1)) ) (write-line " )) ; end setq end list" f) (write-line " (setq Xoff 0)(setq YOff 0)" f) (write-line " (CreateVector BlkList XOff YOff TxCol)" f) (write-line " (end_image)" f) (write-line " ); end progn" f) (write-line " (setq Return \"--**FUNCTION NAME TO INSERT BLOCK**--\")" f) (write-line " ) ; end if" f) (write-line " )" f) (write-line "" f) (write-line "; -OK- ;" f) (close f) ;;open notepad & file ;; (startapp "c:/windows/notepad.exe" tempblock) (vl-catch-all-apply (function (lambda () (setq obj (vlax-get-or-create-object "WScript.Shell")) (vlax-invoke obj 'Run (strcat "c:/windows/notepad.exe \"" tempblock "\"")) ;; or notepad++ if that is used. (setvar 'cmdecho 0) (vlax-invoke obj 'AppActivate "Notepad") ; Title bar name of application. ++ for notepad++ but still works? ) ) ) (if obj (vlax-release-object obj)) (princ) ) These should make it possible to easily get the coordinates to make something like this as a thumbnail: (The Engineers keep asking me to add a legend.... so I do) The second LISP makes up the code I need for my block selection routine, thumbnail graphic, saved in the code, see the image I like, click and paste

As far as I remember the numbers are pairs of points, in your '(' 18 ad 17, 16 and 15..... with the X coordinate to the left and Y to the TOP (unlike usual CAD where Y is counted from the bottom) So your code has an odd number of numbers - I think they need an even number. CAD is off for the evening now, but that might help. You could also post the link to Lees code - usually there is an explanation in there, and also perhaps a screen shot of what you are getting or any errors.

@Tsuky works as well, not sure what @sd2006 is struggling with. The one I posted works the same as the OP's in first post for horizontal align, I just added the vertical align and some error checking. Home today, so also tested in AutoCAD 2000i.

Copy what @SLW210 posted in the other thread into a text file save it as .lsp and load that instead of abc.lsp. The command to type to run SLW210's Lisp is "AlignXY"

You have a topic on this lisp already. please take the time to read it. Bạn đã có một chủ đề về Lisp này rồi. Xin hãy dành chút thời gian để đọc nó.

Nice code SLW210. I did get the error that "acad" is a protected symbol, so its better to use a different name for that one. The code worked fine regardless. We can also do the same thing with entmod: (defun c:unlimitedmleaders (/ e enx) (foreach e (vl-remove-if-not (function (lambda (a) (= (car a) 350))) (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE") ) (setq enx (entget (cdr e))) (entmod (subst '(90 . 0) (assoc 90 enx) enx)) ) (princ) )

@mhupp's LISP works for me, but I took a stab at it anyway. I just tweaked the original abc.lsp, I would prefer if you would post a link to the original so I can properly credit the author. For more information, Kent Cooper has quite a few LISPs for aligning blocks for certain and probably (M)Text, etc. (as well as sorting spacing etc.) on the Autodesk Forums, they should be easy to locate. This worked on your provided drawing as well as one I made for test with Polylines, Lines, Blocks, Mtext, Text and Attributes. ;;; Align selected objects in X or Y direction with reference object. | ;;; | ;;; https://www.cadtutor.net/forum/topic/99091-i-need-a-lisp-to-align-blocks-and-texts-vertically/ | ;;; | ;;; Modified from the provided abc.lsp (author unknown) by SLW210 (a.k.a. Steve Wilson) | ;;; | ;;; Was horizontal only, added vertical align option, error and undo. | ;;; | ;;; *****************************************************************************************************| (defun c:AlignXY (/ *error* OS mode ss albl alpt alptx alpty ctr ename inpt inptx inpty newpt olderr ) ;; Error handler (setq olderr *error*) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (if OS (setvar "OSMODE" OS) ) (command "_.UNDO" "_End") (setq *error* olderr) (princ) ) ;; Save and set system vars (setq OS (getvar "OSMODE")) (setvar "OSMODE" 0) ;; Start UNDO group (command "_.UNDO" "_Begin") ;; Ask user for alignment direction (initget "Horizontal Vertical") (setq mode (getkword "\nAlign [Horizontal/Vertical] <Horizontal>: ")) (if (null mode) (setq mode "Horizontal") ) ;; Select objects (princ "\nSelect blocks or text to align evenly: ") (if (not (setq ss (ssget))) (progn (princ "\nNothing selected.") (*error* "Function cancelled") (exit) ) ) ;; Select reference object (if (not (setq albl (entsel "\nSelect reference text or block: ")) ) (progn (princ "\nNo reference selected.") (*error* "Function cancelled") (exit) ) ) (setq albl (car albl)) (setq alpt (cdr (assoc 10 (entget albl)))) (if (not alpt) (progn (princ "\nInvalid reference object.") (*error* "Function cancelled") (exit) ) ) (setq alptx (car alpt)) (setq alpty (cadr alpt)) ;; Loop through selection (setq ctr 0) (while (setq ename (ssname ss ctr)) (setq inpt (cdr (assoc 10 (entget ename)))) (if inpt (progn (setq inptx (car inpt)) (setq inpty (cadr inpt)) ;; Decide new point (cond ((= mode "Horizontal") (setq newpt (list inptx alpty)) ) ((= mode "Vertical") (setq newpt (list alptx inpty)) ) ) (command "move" ename "" inpt newpt) ) ) (setq ctr (+ ctr 1)) ) ;; End UNDO group cleanly (command "_.UNDO" "_End") ;; Restore vars and error handler (setvar "OSMODE" OS) (setq *error* olderr) (prompt "\nAlignment complete.") (princ) )

Perhaps this would help after you determine the primary dimensions of desired ellipsoid.

Use my above lisp AlignTextBlock that has @Tsuky fix. align.mp4

added a "*" to ssget to pick up mtext or text. updated the foreach to pull the vla-objects name from the selection set. ;;----------------------------------------------------------------------------;; ;; Modify Text or Blocks to align Horozontal or Vertical ;; https://www.cadtutor.net/forum/topic/99091-i-need-a-lisp-to-align-blocks-and-texts-vertically/ (defun C:ATB () (C:AlignTextBlock)) (defun C:AlignTextBlock (/ vars vals pt1 pt2 vector mode ent ed pt newpt) (vl-load-com) (setq vars '(OSMODE ORTHOMODE) vals (mapcar 'getvar vars) ) (mapcar 'setvar vars '(0 1)) (setq pt1 (getpoint "\nAlignment Point: ")) (setq pt2 (getpoint pt1 "\nSelect Horozontal or Vertical:")) (setq vector (mapcar '- pt2 pt1)) (if (eq (car Vector) 0.0) (setq mode 'V) (setq mode 'H)) (while (setq ss (ssget '((0 . "*TEXT,INSERT")))) (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))) (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj))) newpt (if (eq mode 'V) (list (car pt1) (cadr pt) (caddr pt)) (list (car pt) (cadr pt1) (caddr pt))) ) (vla-Move obj (vlax-3d-point pt) (vlax-3d-point newpt)) ) ) (mapcar 'setvar vars vals) (princ) ) (princ "\nAlignTextBlock Lisp Loaded") (princ "\nType ATB or AlignTextBlock to run command")

notice your lisp name is MoveLayerAllLayouts that mean other tabs other than model? ssget "_X" wont pick up things on other tabs if they are on that layer. So if your moving everything might assume your deleting the old layer. if that's the case just rename it. no need to mess with ssget and will pick up everything. (vl-cmdf "_.-Rename" "LA" old new)

Thank you so much. This has been annoying me for decades. Pity I only found out how to fix it right on my retirement.

AutoCAD has PDFSHXTEXT to convert the vector lines/arcs that once were SHX texts back to texts. Post the converted PDF file from ZWCAD. Sounds like you need to use something better than ZWCAD if it isn't capable of doing what you need. This still goes back to you need to use TTFs.

A version also for closed polylines. Minimally tested... centerPline_v2.LSP

I think it was a Renault car it had only 3 wheel studs so the front hub would look something like that. Note the internal groove for a seal. Thats where the section would show that clearly.

Thanks, will check that out later.