View Full Version : Block Align
laitecksian
2007-07-17, 03:18 AM
Hi Everyone,
I have download a lisp file call "text align" and it's very useful for me, and I hope it can be modify become "block align". Because I always have a lot of block to insert and need to be aligned it by following line alignment.
Can anyone help me on this? Thanks.. I attached below is a "text align" lisp.
(defun c:TA (/ CE BM OM LT LD ID LS LE AN AD AX AA BB CC)
(setq CE (getvar "CMDECHO"))
(setq BM (getvar "BLIPMODE"))
(setq OM (getvar "OSMODE"))
(defun NE (NE)
(setvar "CMDECHO" CE)
(setvar "BLIPMODE" BM)
(setvar "OSMODE" OM)
(princ "Function cancelled ")
(princ)
)
(setq OE *error* *error* NE)
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setvar "OSMODE" 0)
(while (= LT nil)
(setq LT (entsel "\nSelect line for text alignment: "))
)
(setq LD (entget (car LT))
ID (cdr (assoc 0 LD))
LS (cdr (assoc 10 LD))
LE (cdr (assoc 11 LD))
)
(if (= ID "LINE")
(prompt "\nAngle of selected line is ")
(prompt "\nEntity selected is not a line, try again. ")
)
(if (/= ID "LINE") (quit))
(setq AN (angle LS LE))
(setq AD (* AN 57.2958 ))
(princ AD) (prompt " degrees.")
(if (and (>= AN (/ pi 2)) (<= AN (* pi 1.5))) (setq AN (- AN pi)))
(setq AX (entsel "\nSelect text for alignment with line: "))
(setq AA (entget (car AX)))
(setq BB (assoc 50 AA))
(setq CC (cons 50 AN))
(entmod (subst CC BB AA))
;;;(command "move" AX "" );;to adjust location of text after rotation
(setvar "BLIPMODE" BM)
(setvar "CMDECHO" CE)
(setvar "OSMODE" OM)
(setq *error* OE OE nil)
(princ)
)
Thanks
jmcshane
2007-07-17, 12:56 PM
Can you post an example of what you are trying to do ?
watsonlisp
2007-07-18, 01:16 AM
Hi Lai,
Do you want the block rotation parallel to an object?
watsonlisp
2007-07-18, 07:50 PM
;This autolisp program rotates blocks parallel to an entity.
(DEFUN C:RAB ()
(PROMPT "\n*ROTATIONAL ALIGNMENT OF BLOCK* ")
(SETQ BENT (CAR (ENTSEL "\nSelect block to align: ")))
(SETQ BENTL (ENTGET BENT))
(SETQ BENTLIP (CDR (ASSOC 10 BENTL)))
(SETQ BENTLT (CDR (ASSOC 0 BENTL)))
(IF (= BENTLT "INSERT")
(PROGN
(COMMAND "CHANGE" BENT "" "" "" "0")
(COMMAND "ROTATE" BENT "" BENTLIP "90")
(COMMAND "ROTATE" BENT "" BENTLIP "PER" PAUSE)
);END PROGN
(PROMPT "\nENTITY NOT A BLOCK. ")
);END IF BENTLT
(PRINC)
); END RAB
laitecksian
2007-07-19, 03:31 AM
Hi everyone,
Actually the sequence of block align lisp I want should be like the text align lisp.
1) Select line for block object alignment (get the angle)
2) Select block for alignment with line. (Choose the block to be rotated)
3) use rotate command, base point is insertion point and rotation angle with follow the line angle
I attached an example in jpg format and hope all of you can understand what do I mean.
Once again, thank you all for reply my question.
If you want to use your routine
just change a few lines
(defun c:TB (/ AA AD AN BB BM BX CC CE ID LD LE LS LT OM)
(setq CE (getvar "CMDECHO"))
(setq BM (getvar "BLIPMODE"))
(setq OM (getvar "OSMODE"))
(defun NE (NE)
(setvar "CMDECHO" CE)
(setvar "BLIPMODE" BM)
(setvar "OSMODE" OM)
(princ "Function cancelled ")
(princ)
)
(setq OE *error* *error* NE)
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setvar "OSMODE" 0)
(while (= LT nil)
(setq LT (entsel "\nSelect line for text alignment: "))
)
(setq LD (entget (car LT))
ID (cdr (assoc 0 LD))
LS (cdr (assoc 10 LD))
LE (cdr (assoc 11 LD))
)
(if (= ID "LINE")
(prompt "\nAngle of selected line is ")
(prompt "\nEntity selected is not a line, try again. ")
)
(if (/= ID "LINE") (quit))
(setq AN (angle LS LE))
(setq AD (* AN 57.2958 ))
(princ AD) (prompt " degrees.")
(if (and (>= AN (/ pi 2)) (<= AN (* pi 1.5))) (setq AN (- AN pi)))
(setq BX (entsel "\nSelect block for alignment with line: "))
(setq AA (entget (car BX)))
(setq BB (assoc 50 AA))
(setq CC (cons 50 AN))
(entmod (subst CC BB AA))
;;;(command "move" BX "" );;to adjust location of block after rotation
(setvar "BLIPMODE" BM)
(setvar "CMDECHO" CE)
(setvar "OSMODE" OM)
(setq *error* OE OE nil)
(princ)
)
laitecksian
2007-07-19, 11:38 AM
Yes, this is the thing I want. Thank you!!
Is it possible to repeat the command to rotate a few block until right click to end it? and also the Text Align code as well.
I am sorry that I don't know about AutoLisp code. So, I don't know how to change the code even it's very simple. This is my first time post a question in Augi, I feel warm because get so many reply. I am very appreciate it. Thanks a lot.
This will allows to iterate trough lines,
but do not miss when select objects
To stop loop just click a right button
or hit Enter
~'J'~
(defun c:TB (/ AA AD AN BB BM BX CC CE ID LD LE LS LT OM)
(setq CE (getvar "CMDECHO"))
(setq BM (getvar "BLIPMODE"))
(setq OM (getvar "OSMODE"))
(defun NE (NE)
(setvar "CMDECHO" CE)
(setvar "BLIPMODE" BM)
(setvar "OSMODE" OM)
(princ "Function cancelled ")
(princ)
)
(setq OE *error* *error* NE)
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setvar "OSMODE" 0)
(alert "Select objects with\naccuracy, do not miss")
(while
(setq LT (entsel "\nSelect line for text alignment: "))
;;;(while (= LT nil)
;;;(setq LT (entsel "\nSelect line for text alignment: "))
;;;)
(setq LD (entget (car LT))
ID (cdr (assoc 0 LD))
LS (cdr (assoc 10 LD))
LE (cdr (assoc 11 LD))
)
(if (= ID "LINE")
(prompt "\nAngle of selected line is ")
(prompt "\nEntity selected is not a line, try again. ")
)
(if (/= ID "LINE") (quit))
(setq AN (angle LS LE))
(setq AD (* AN 57.2958 ))
(princ AD) (prompt " degrees.")
(if (and (>= AN (/ pi 2)) (<= AN (* pi 1.5))) (setq AN (- AN pi)))
(setq BX (entsel "\nSelect block for alignment with line: "))
(setq AA (entget (car BX)))
(setq BB (assoc 50 AA))
(setq CC (cons 50 AN))
(entmod (subst CC BB AA)))
;;;(command "move" BX "" );;to adjust location of block after rotation
(setvar "BLIPMODE" BM)
(setvar "CMDECHO" CE)
(setvar "OSMODE" OM)
(setq *error* OE OE nil)
(princ)
)
;;;TesT : (c:TB)
(princ "\n\t\t***\tType TB to align blocks by lines\t***")
(princ)
laitecksian
2007-07-20, 01:31 AM
Fixo, thanks for the code, It's really amazing.
By the way, can I have another code for just keep repeat rotate many block/text by following only one line selected?
Thanks.
Okay, here is edited version
that allows to align blocks or texts with
line as many as you need
;; local defun
;; to select entity
;; I've forgot who is an author of this function :(
(defun pick (msg / flag)
(if (not msg)
(setq msg "\nSelect object: ")
)
(while (not flag)
(setvar "errno" 0)
(if (or (setq na (entsel msg))
(= (getvar "errno") 52)
)
(progn
(setq flag T)
(setq pt (cadr na))
(setq na (car na))
)
(progn
(if (/= (getvar "errno") 52)
(alert "You missed! Try Again!")
)
)
)
)
na
)
;; main part
(defun c:TM (/ AA AD AN BB BM BX CC CE ID LD LE LS LT OM)
(setq CE (getvar "CMDECHO"))
(setq BM (getvar "BLIPMODE"))
(setq OM (getvar "OSMODE"))
(defun NE (NE)
(setvar "CMDECHO" CE)
(setvar "BLIPMODE" BM)
(setvar "OSMODE" OM)
(princ "Function cancelled ")
(princ)
)
(setq OE *error* *error* NE)
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setvar "OSMODE" 0)
(alert "Select objects with\naccuracy, do not miss")
(while
(setq LT (entsel "\nSelect line for text alignment (hit Enter to exit): "))
;;;(while (= LT nil)
;;;(setq LT (entsel "\nSelect line for text alignment: "))
;;;)
(setq LD (entget (car LT))
ID (cdr (assoc 0 LD))
LS (cdr (assoc 10 LD))
LE (cdr (assoc 11 LD))
)
(if (= ID "LINE")
(prompt "\nAngle of selected line is ")
(prompt "\nEntity selected is not a line, try again. ")
)
(if (/= ID "LINE") (quit))
(setq AN (angle LS LE))
(setq AD (* AN 57.2958 ))
(princ AD) (prompt " degrees.")
(if (and (>= AN (/ pi 2)) (<= AN (* pi 1.5))) (setq AN (- AN pi)))
;;;(setq BX (entsel "\nSelect block for alignment with line: "))
(while (setq BX (pick "\nSelect block or text for alignment with line (Enter to go next line): "))
(setq AA (entget BX))
(setq BB (assoc 50 AA))
(setq CC (cons 50 AN))
(entmod (subst CC BB AA))))
;;;(command "move" BX "" );;to adjust location of block after rotation
(setvar "BLIPMODE" BM)
(setvar "CMDECHO" CE)
(setvar "OSMODE" OM)
(setq *error* OE OE nil)
(princ)
)
;;;TesT : (c:TB)
(princ "\n\t\t***\tType TM to align blocks by lines\t***")
(princ)
laitecksian
2007-07-21, 01:36 AM
Got it!! Thank you. :)
You are quite welcome
Cheers :)
~'J'~
gilsoto13
2009-10-05, 08:08 PM
I guess now you can use the Rotateobjects... could it be TA (Total align) from Alan J. Thompson to rotate any number of text, mtext, blocks and other to any line, polyline, lwpolyline or even a block rotation aangle... I think it sounds better. I use it oftenly.
It will even ask you for flipping the objects 180 degrees if you want so.
Okay, here is edited version
that allows to align blocks or texts with
line as many as you need
;; local defun
;; to select entity
;; I've forgot who is an author of this function :(
(defun pick (msg / flag)
(if (not msg)
(setq msg "\nSelect object: ")
)
(while (not flag)
(setvar "errno" 0)
(if (or (setq na (entsel msg))
(= (getvar "errno") 52)
)
(progn
(setq flag T)
(setq pt (cadr na))
(setq na (car na))
)
(progn
(if (/= (getvar "errno") 52)
(alert "You missed! Try Again!")
)
)
)
)
na
)
;; main part
(defun c:TM (/ AA AD AN BB BM BX CC CE ID LD LE LS LT OM)
(setq CE (getvar "CMDECHO"))
(setq BM (getvar "BLIPMODE"))
(setq OM (getvar "OSMODE"))
(defun NE (NE)
(setvar "CMDECHO" CE)
(setvar "BLIPMODE" BM)
(setvar "OSMODE" OM)
(princ "Function cancelled ")
(princ)
)
(setq OE *error* *error* NE)
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setvar "OSMODE" 0)
(alert "Select objects with\naccuracy, do not miss")
(while
(setq LT (entsel "\nSelect line for text alignment (hit Enter to exit): "))
;;;(while (= LT nil)
;;;(setq LT (entsel "\nSelect line for text alignment: "))
;;;)
(setq LD (entget (car LT))
ID (cdr (assoc 0 LD))
LS (cdr (assoc 10 LD))
LE (cdr (assoc 11 LD))
)
(if (= ID "LINE")
(prompt "\nAngle of selected line is ")
(prompt "\nEntity selected is not a line, try again. ")
)
(if (/= ID "LINE") (quit))
(setq AN (angle LS LE))
(setq AD (* AN 57.2958 ))
(princ AD) (prompt " degrees.")
(if (and (>= AN (/ pi 2)) (<= AN (* pi 1.5))) (setq AN (- AN pi)))
;;;(setq BX (entsel "\nSelect block for alignment with line: "))
(while (setq BX (pick "\nSelect block or text for alignment with line (Enter to go next line): "))
(setq AA (entget BX))
(setq BB (assoc 50 AA))
(setq CC (cons 50 AN))
(entmod (subst CC BB AA))))
;;;(command "move" BX "" );;to adjust location of block after rotation
(setvar "BLIPMODE" BM)
(setvar "CMDECHO" CE)
(setvar "OSMODE" OM)
(setq *error* OE OE nil)
(princ)
)
;;;TesT : (c:TB)
(princ "\n\t\t***\tType TM to align blocks by lines\t***")
(princ)
p.gerhardus
2009-10-09, 06:39 PM
RotateObjects.lsp
Rotate blocks, text, mtext and multileaders!!
ENJOY
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.