Command: LUV
Lines up selected block/text/mtext objects vertically. Handy for annotating the drawing.Command: LUH
As above but lines up horizontally.Command: CLDR (Copy Leader)
Copies lieader to lined up annotation blocks/texts and allows user to correct its target automatically.Command: LUSETTINGS
Asks for vertical and horizontal offset distance that is to be used in LUV, LUH and CLDR command and saves it as default for next use. The user doesnt have to set it each time.Code:
;;; =================================================
;;; LINE_UP_v2_01.LSP
;;;
;;; Written by Andrzej Kalinowski, www.autolisps.blogspot.com
;;; v1.00 - 30.11.2015 - first release
;;; v2.00 - 31.05.2019 - modified to lune up multiple objects at once, added LUSETTINGS command
;;; v2.01 - 28.07.2020 - fixed bug with unknown GET_AECBOSMODE command
;;;
;;; Command: LUV - lines up selected block/text/mtext objects vertically. Handy for annotating the drawing.
;;; Command: LUH - as above but lines up horizontally.
;;; Command: CLDR - (Copy Leader) copies lieader to lined up annotation blocks/texts and allows user to correct its target automatically.
;;; Command: LUSETTINGS - asks for vertical and horizontal offset distance used in LUV, LUH and CLDR command
;;; and saves it as default for next use. The user doesnt have to set it each time.
;;; =================================================
(vl-load-com)
(defun C:LUSETTINGS (/ blkOfsV blkOfsH)
(if (= (getenv "LU_DIST_V") nil) (setq blkOfsV "not specified") (setq blkOfsV (getenv "LU_DIST_V") ) )
(if (= (getenv "LU_DIST_H") nil) (setq blkOfsH "not specified") (setq blkOfsH (getenv "LU_DIST_H") ) )
(setq blkOfsV (getreal (strcat "\nSpecify vertical offset distance for LUV command <" blkOfsV ">:" ) ) )
(if (/= nil blkOfsV) (setenv "LU_DIST_V" (rtos blkOfsV 2 8) ) )
(setq blkOfsH (getreal (strcat "\nSpecify horizontal offset distance for LUH command <" blkOfsH ">:" ) ) )
(if (/= nil blkOfsH) (setenv "LU_DIST_H" (rtos blkOfsH 2 8) ) )
;all environment variables can be found at \HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R22.0\ACAD-1006:409\FixedProfile\General
);defun
;;; ================================================
; LUV LUH
;;; ================================================
(defun c:LUV () (LINE_UP_COMMON 0) );defun
(defun c:LUH () (LINE_UP_COMMON 1) );defun
(defun LINE_UP_COMMON (mode2 / blkOfs blkOfstxt obj3 obj2 pt1 pt2 pt3 lst2 item1 i1)
(setq doc1 (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc1)
;-----------------------------------------
; error section
;-----------------------------------------
(defun *error* (msg) (princ "error: ") (princ msg) (princ) );
(defun errtrap1 (errormsg1 / )
(LU_RESTORE)
(if (and errormsg1 (not (wcmatch (strcase errormsg1) "*BREAK*,*CANCEL*,*QUIT*") ) )
(prompt (strcat "\n--------\nError: " errormsg1) );then
);if
(princ)
);defun err
;-----------------------------------------
;setting variables
;-----------------------------------------
(setq
temperr *error*
*error* errtrap1
old_osmode (getvar "OSMODE")
old_aecbosmode (GET_AECBOSMODE)
old_orthomode (getvar "orthomode")
);setq
(setvar "OSMODE" 0)
(setvar "orthomode" 0)
(if (/= old_aecbosmode nil) (command "aecbosmode" 0) );if
;-----------------------------------------
(cond
( (= mode2 0)
(if (= (getenv "LU_DIST_V") nil) (c:LUSETTINGS) )
(setq blkOfstxt (getenv "LU_DIST_V") )
(setq blkOfs (distof blkOfstxt 2))
)
( (= mode2 1)
(if (= (getenv "LU_DIST_H") nil) (c:LUSETTINGS) )
(setq blkOfstxt (getenv "LU_DIST_H") )
(setq blkOfs (distof blkOfstxt 2))
)
);cond
(princ (strcat "\nOffset disatnce=" blkOfstxt ". To change it - enter LUSETTINGS command.") )
;-----------------------------------------
; objects selection
;-----------------------------------------
(setq lst2 (LU_OBJ_SEL1 ) );list of elements
(setq obj2 (car lst2) )
(while (member obj2 lst2 )
(setq obj2 (LU_OBJ_SEL) )
);While
(setq obj2 (vlax-ename->vla-object obj2 ) );base object
(setq pt2 (vlax-get obj2 'InsertionPoint) )
(setq pt3 (getpoint pt2 "\nPoint the direction: ") )
;-----------------------------------------
;offset
;-----------------------------------------
(setq i1 1)
(cond
( (= mode2 0)
(foreach item1 lst2
(if (> (cadr pt3) (cadr pt2) );checks if pickpoint specifying duirection is above or below base object
(setq pt3 (list (car pt2) (+ (cadr pt2) (* i1 blkOfs) ) (caddr pt2) ) );then
(setq pt3 (list (car pt2) (- (cadr pt2) (* i1 blkOfs) ) (caddr pt2) ) );else
);end if
(vla-put-insertionpoint (vlax-ename->vla-object item1 ) (vlax-3D-point pt3) )
(setq i1 (1+ i1) )
);foreach
)
( (= mode2 1)
(foreach item1 lst2
(if (> (car pt3) (car pt2) );checks if pickpoint specifying duirection is above or below base object
(setq pt3 (list (+ (car pt2) (* i1 blkOfs) ) (cadr pt2) (caddr pt2) ) );then
(setq pt3 (list (- (car pt2) (* i1 blkOfs) ) (cadr pt2) (caddr pt2) ) );else
);end if
(vla-put-insertionpoint (vlax-ename->vla-object item1 (vlax-3D-point pt3) ) )
(setq i1 (1+ i1) )
);foreach
)
);cond
;-----------------------------------------
;restoring system variables
;-----------------------------------------
(LU_RESTORE)
(princ);exiting quietly
);end defun
;;; ================================================
; LULDR
;;; ================================================
(defun c:CLDR ( / ldr1 coords1 basePt nextPt obj2 ldr2 gr1)
(setq ldr1 nil)
(while (= ldr1 nil)
(if (setq ldr1 (car (entsel "\nSelect leader: ")))
(if (/= (cdr (assoc 0 (entget ldr1) ) ) "LEADER" )
(setq ldr1 nil)
);if
);if
);while
(setq obj2 (LU_OBJ_SEL) )
(setq basePt (vlax-get (vlax-ename->vla-object obj2 ) 'InsertionPoint) )
(setq gr1 1)
(while (/= gr1 52);null response code
(setvar "ERRNO" 0);reset ERRNO to 0
(setq obj3 (car (entsel "\nSelect Target Block, Text or Mtext: ")))
(setq gr1 (getvar "ERRNO") )
(if (/= obj3 nil)
(if (and
(member (cdr (assoc 0 (entget obj3) ) ) (list "INSERT" "TEXT" "MTEXT"))
(=(vla-get-lock (vla-item(vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ))(vla-get-layer (vlax-ename->vla-object obj3)))):vlax-false )
);and
(progn
(setq nextPt (vlax-get (vlax-ename->vla-object obj3 ) 'InsertionPoint) );if - building list of selected objects in order of selection
(setq ldr2 (vla-copy (vlax-ename->vla-object ldr1 ) ))
(vla-move ldr2 (vlax-3D-point basePt) (vlax-3D-point nextPt))
(setq coords1 (vlax-get ldr2 'Coordinates) )
(setq nextPt (list (car coords1) (cadr coords1) (caddr coords1) ) )
(setq nexPt (getpoint nextPt "\nPick Leader target: ") )
(setq coords1 (cons (cadr nexPt) (cdr (cdr coords1) ) ) )
(setq coords1 (cons (car nexPt) coords1 ) )
(vlax-put ldr2 'Coordinates coords1)
);progn
);if
);if
);while
(princ)
);defun
;;; ================================================
; LU_RESTORE
;;; ================================================
(defun LU_RESTORE ( / )
(setvar "OSMODE" old_osmode)
(setvar "ORTHOMODE" old_orthomode)
(setq *error* temperr);restoring to previous *error* definition
(if (not command-s);works in error handler
(if (/= old_aecbosmode nil) (command "aecbosmode" old_aecbosmode) )
(if (/= old_aecbosmode nil) (command-s "aecbosmode" old_aecbosmode) )
);if
(setq old_aecbosmode nil old_osmode nil old_orthomode nil temperr nil)
(sssetfirst nil nil)
(vla-endundomark doc1)
);defun
;;; ================================================
; LU_OBJ_SEL1
;;; ================================================
(defun LU_OBJ_SEL1 ( / gr1 obj3 lst1 msg2 sst1)
(graphscr)
(setq lst1 (list) gr1 1 sst1 (ssadd) )
(while (/= gr1 52);null response code
(setvar "ERRNO" 0);reset ERRNO to 0
(setq obj3 (car (entsel "\nSelect Block, Text or Mtext: ")))
(setq gr1 (getvar "ERRNO") )
(if (and (/= obj3 nil) (not (member obj3 lst1 )) )
(if (and
(member (cdr (assoc 0 (entget obj3) ) ) (list "INSERT" "TEXT" "MTEXT"))
(=(vla-get-lock (vla-item(vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ))(vla-get-layer (vlax-ename->vla-object obj3)))):vlax-false )
);and
(progn
(setq lst1 (cons obj3 lst1));if - building list of selected objects in order of selection
(setq sst1 (ssadd obj3 sst1) )
(vlax-invoke-method (vlax-ename->vla-object obj3) 'Highlight :vlax-true)
(sssetfirst nil sst1)
);progn
(princ "\nWrong object...")
);if
);if
);while
(reverse lst1)
);defun
;;; ================================================
; LU_OBJ_SEL
;;; ================================================
(defun LU_OBJ_SEL ( / Sobj3 )
(setq Sobj3 nil)
(while (= Sobj3 nil)
(if (setq Sobj3 (car(entsel "\nSelect base object (block, text or mtext): ")))
(if (and
(not (member (cdr (assoc 0 (entget Sobj3) ) ) (list "INSERT" "TEXT" "MTEXT")) )
(=(vla-get-lock (vla-item(vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ))(vla-get-layer (vlax-ename->vla-object Sobj3)))):vlax-false )
);and
(setq Sobj3 nil)
);if
);if
);while
Sobj3
);defun
;;; =================================================
;;; GET_AECBOSMODE_v2_00.LSP
;;;
;;; Function gets AECBOSMODE value
;;; Program is universal if you want f.e to implement it into program that turns off all snaps
;;; regardles of if it is autocad mep/architecture or classic autocad that doesn't recognise AECBOSMODE command
;;; =================================================
(defun GET_AECBOSMODE ( / AecbOM old_cmdecho998)
(vl-load-com)
(setq old_cmdecho998 (getvar "CMDECHO"))
(if (not (= (getcname "AECBOSMODE") nil) ) ;checks if aecbosmode is available in case the user uses other version of autocad.
(progn
(setvar "CMDECHO" 1);necessary to read last prompt with current AECBOSMODE
(command "AECBOSMODE" )
(command);breaks command
(setq AecbOM (getvar "lastprompt") )
(setq
AecbOM (substr AecbOM (+ 2 (vl-string-position (ascii "<") AecbOM) ) (strlen AecbOM) )
AecbOM (vl-list->string (reverse (vl-string->list AecbOM)))
AecbOM (substr AecbOM (+ 2 (vl-string-position (ascii ">") AecbOM) ) (strlen AecbOM) )
AecbOM (atoi (vl-list->string (reverse (vl-string->list AecbOM))))
);setq
(setvar "CMDECHO" old_cmdecho998)
);progn
(setq AecbOM nil);else
);if
;if aecbosmode command is unknown by version of autocad (f.e. in Classic autocad) AecbOM global variable
;is set to f.e. nil ( some other value than any number from 0 to 1023 - possible values of AECBOSMODE)
;---------------------------else
AecbOM ;last statement of the function
);defun
Example:
1.00 - 30.11.2015 - first release
2.00 - 31.05.2019 - modified to lune up multiple objects at once, added LUSETTINGS command
2.01 - 28.07.2020 - fixed bug with unknown GET_AECBOSMODE command
File format:
.FAS
Compatibility:
-All Autocad versions
Remarks:
-The application comes with the long command names listed above. To create your own short aliases for these commands, go to ACAD.PGP file or Menu Manage->Customization->Edit aliases->Edit Aliases
Downlad file:
LINE_UP_v2_01.FAS
No comments:
Post a Comment