LISP Tools – lisp-solutions

Below you’ll find a collection of practical AutoLISP tools for AutoCAD and BricsCAD, designed to automate repetitive drafting tasks and improve productivity.

If you need help loading scripts, see the AutoLISP Installation & Startup Guide for step-by-step instructions on how to install, load, and customize these tools.

Dimension Chain

Program to select and move chains of dimensions.
A chain is defined as a group of dimensions that are colinear and have a gap between them that is smaller than the specified value.
Use: Pick a dimension in the chain, then select the new location directly if object snap is enabled, or move the chain interactively until you confirm the position if object snap is disabled.

Commands:

DIMS_MOVE_LS – Moves a chain of dimensions. If object snap is enabled, select the new location directly; if disabled, move the chain interactively until you confirm the position.
DIMS_SEL_LS – Selects a chain of dimensions.
DIMS_SET_LS – Sets the gap between the dimension chains.

Download tool

AutoLISP code

Lisp

;;; Description: Program to select and move chains of dimensions.
;;; A chain is defined as a group of dimensions that are colinear and have a gap between them that is smaller than the specified value.
;;; Use: Pick a dimension in the chain, then select the new location directly if object snap is enabled, or move the chain interactively until you confirm the position if object snap is disabled
(vl-load-com)

  (princ 
    (strcat 
      “\nProgram to select and move chains of dimensions.”
      “\nCommands: ”
      “\nDIMS_MOVE_LS – Moves a chain of dimensions. If object snap is enabled, select the new location directly; if disabled, move the chain interactively until you confirm the position.”
      “\nDIMS_SEL_LS – Selects a chain of dimensions.”
      “\nDIMS_SET_LS – Sets the gap between the dimension chains.”
      “\n(c) ”
      (substr (rtos (getvar “CDATE”) 2 0) 1 4)
      ” lisp-solutions.com”
    )
  )

  (princ)



;;;;;;;;;;;;;;;;;;;;;;-COMMANDS-;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:DIMS_MOVE_LS (/ dim i inp p0 point ss MOVE_DIMS *error*) 
  (defun *error* (msg) 
    (if (not (wcmatch (strcase msg) “*BREAK,*CANCEL*,*EXIT*”)) 
      (princ (strcat “\nDIMS_MOVE_LS Error: ” msg))
    )
    (princ)
  )
  (defun MOVE_DIMS (point ss / e_dx) 
    (setq point (trans point 1 0))
    (repeat (setq i (SSLENGTH ss)) 
      (setq e (ssname ss (setq i (1- i))))
      (setq e_dx (entget e))
      (entmod (subst (cons 10 point) (assoc 10 e_dx) e_dx))
      (entupd e)
    )
  )

  (if 
    (and (setq inp (entsel “\nPick dimension in chain >>”)) 
         (setq dim (car inp)
               p0  (cadr inp)
         )
         (wcmatch (cdr (assoc 0 (entget dim))) “*DIMENSION*”)
    )
    (progn 
      (setq ss (LS:DIM_CHAIN_DSEL dim))

      (SSSETFIRST ss ss)
      (if (zerop (logand 16384 (getvar ‘OSMODE))) 
        (if (setq p (GETPOINT “\nPick new location >>” p0)) 
          (MOVE_DIMS p ss)
        )
        (while (= 5 (car (setq gres (grread t)))) 
          (MOVE_DIMS (cadr gres) ss)
        )
      )
    )
  )
  (princ)
)

(defun C:DIMS_SEL_LS (/ dim ss) 
  (if 
    (and 
      (setq dim (car (entsel “\nPick dimension in chain >>”)))
      (wcmatch (cdr (assoc 0 (entget dim))) “*DIMENSION*”)
    )
    (progn 
      (setq ss (LS:DIM_CHAIN_DSEL dim))
      (SSSETFIRST ss ss)
    )
  )
  (princ)
)

(defun C:DIMS_SET_LS () 
  (vlax-ldata-put 
    “AI_DIMS”
    “MaxGap”
    (getdist 
      “Enter max. gap between the dimension chains <Press enter to select all>”
    )
  )
  (princ)
)

(princ)


;;;;;;;;;;;;;;;;-utility functions-;;;;;;;;;;;;;;;;;;;
(defun LS:DIM_CHAIN_DSEL (dim / max_gap dims_colinear dims_groups dims_sorted dim_dx 
                          p10 p14 ss e vec COLINEAR DIMS_SORT DIMSSORTED_SPLIT DICTAD 
                          SS2LST LST2SS
                         ) 


  (if (null (assoc “MaxGap” (vlax-ldata-list “AI_DIMS”))) 
    (vlax-ldata-put “AI_DIMS” “MaxGap” 0.001)
  )
  (setq max_gap (vlax-ldata-get “AI_DIMS” “MaxGap”))
  (setq dim_dx (entget dim))
  (if 
    (setq ss (ssget “_A” 
                    (list ‘(0 . “DIMENSION”) 
                          (assoc 3 dim_dx)
                          (assoc 8 dim_dx)
                    )
             )
    )

    (progn 
      (LS:DIM_LOAD_UTILS)

      (setq p14 (cdr (assoc 14 dim_dx))
            p10 (cdr (assoc 10 dim_dx))
            vec (polar p10 (+ (angle p14 p10) (/ pi 2)) 10)
      )
      (setq dims_colinear (vl-remove-if-not 
                            ‘(lambda (e) 
                               (COLINEAR 
                                 p10
                                 vec
                                 (cdr (assoc 10 (entget e)))
                                 0.001
                               )
                             )
                            (SS2LST ss)
                          )
      )
      (if (and max_gap (< 2 (length dims_colinear))) 
        (progn 
          (setq dims_sorted (DIMS_SORT dims_colinear vec))

          (setq dims_groups (DIMSSORTED_SPLIT dims_sorted max_gap))
          (LST2SS 
            (car 
              (vl-remove-if-not 
                ‘(lambda (le) (member dim le))
                dims_groups
              )
            )
          )
        )
        (LST2SS dims_colinear)
      )
    )
  )
)

(defun LS:DIM_LOAD_UTILS () 

  (defun COLINEAR (p1 p2 p3 fuzz / d12 d13 d23) 
    (setq d12 (distance p1 p2)
          d13 (distance p1 p3)
          d23 (distance p2 p3)
    )
    (or 
      (equal (+ d12 d23) d13 fuzz)
      (equal (+ d13 d23) d12 fuzz)
      (equal (+ d12 d13) d23 fuzz)
    )
  )

  (defun DIMSSORTED_SPLIT (dims_sorted max_gap / c cr1 cr2 res) 
    (setq c 0)
    (while (cadr dims_sorted) 
      (setq cr1 (car dims_sorted)
            cr2 (car (setq dims_sorted (cdr dims_sorted)))
      )

      (if (equal (nth 2 cr1) (nth 1 cr2) max_gap) 
        (setq res (DICTAD res (list (cons c (list (car cr1) (car cr2))))))
        (setq c (1+ c))
      )
    )
    (mapcar ‘cdr res)
  )


  (defun DIMS_SORT (dims vec) 
    (vl-sort 
      (mapcar 
        ‘(lambda (e) 
           (cons 
             e
             (vl-sort 
               (list 
                 (nth 2 (trans (cdr (assoc 13 (entget e))) 0 vec))
                 (nth 2 (trans (cdr (assoc 14 (entget e))) 0 vec))
               )
               ‘<
             )
           )
         )
        dims
      )
      ‘(lambda (ese1 ese2) (< (cadr ese1) (cadr ese2)))
    )
  )

  (defun DICTAD (dict key_val / pair key val) 
    (if (not dict) 
      (setq dict ‘())
    )
    (foreach kv key_val 
      (setq key (car kv)
            val (cdr kv)
      )
      (if (/= (type val) ‘LIST) 
        (setq val (list val))
      )

      (setq pair (assoc key dict))
      (if pair 
        (setq dict (subst (cons (car pair) (append (cdr pair) val)) 
                          pair
                          dict
                   )
        )

        (setq dict (append dict (list (cons key val))))
      )
    )
    dict
  )

  (defun SS2LST (ss / e lst i) 
    (if (and ss (/= 0 (setq i (SSLENGTH ss)))) 
      (repeat i 
        (setq e (ssname ss (setq i (1- i))))
        (setq lst (cons e lst))
      )
    )
    (reverse lst)
  )

  (defun LST2SS (lst / e ss) 
    (setq ss (ssadd))
    (foreach e lst 
      (if (= ‘VLA-OBJECT (type e)) 
        (setq e (handent (vlax-get e ‘handle)))
      )
      (ssadd e ss)
    )
    ss
  )
)
;;End LOAD_UTILS



;;;EOF

;;; Description: Program to select and move chains of dimensions.
;;; A chain is defined as a group of dimensions that are colinear and have a gap between them that is smaller than the specified value.
;;; Use: Pick a dimension in the chain, then select the new location directly if object snap is enabled, or move the chain interactively until you confirm the position if object snap is disabled
(vl-load-com)

  (princ 
    (strcat 
      "\nProgram to select and move chains of dimensions."
      "\nCommands: "
      "\nDIMS_MOVE_LS - Moves a chain of dimensions. If object snap is enabled, select the new location directly; if disabled, move the chain interactively until you confirm the position."
      "\nDIMS_SEL_LS - Selects a chain of dimensions."
      "\nDIMS_SET_LS - Sets the gap between the dimension chains."
      "\n(c) "
      (substr (rtos (getvar "CDATE") 2 0) 1 4)
      " lisp-solutions.com"
    )
  )

  (princ)



;;;;;;;;;;;;;;;;;;;;;;-COMMANDS-;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:DIMS_MOVE_LS (/ dim i inp p0 point ss MOVE_DIMS *error*) 
  (defun *error* (msg) 
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) 
      (princ (strcat "\nDIMS_MOVE_LS Error: " msg))
    )
    (princ)
  )
  (defun MOVE_DIMS (point ss / e_dx) 
    (setq point (trans point 1 0))
    (repeat (setq i (SSLENGTH ss)) 
      (setq e (ssname ss (setq i (1- i))))
      (setq e_dx (entget e))
      (entmod (subst (cons 10 point) (assoc 10 e_dx) e_dx))
      (entupd e)
    )
  )

  (if 
    (and (setq inp (entsel "\nPick dimension in chain >>")) 
         (setq dim (car inp)
               p0  (cadr inp)
         )
         (wcmatch (cdr (assoc 0 (entget dim))) "*DIMENSION*")
    )
    (progn 
      (setq ss (LS:DIM_CHAIN_DSEL dim))

      (SSSETFIRST ss ss)
      (if (zerop (logand 16384 (getvar 'OSMODE))) 
        (if (setq p (GETPOINT "\nPick new location >>" p0)) 
          (MOVE_DIMS p ss)
        )
        (while (= 5 (car (setq gres (grread t)))) 
          (MOVE_DIMS (cadr gres) ss)
        )
      )
    )
  )
  (princ)
)

(defun C:DIMS_SEL_LS (/ dim ss) 
  (if 
    (and 
      (setq dim (car (entsel "\nPick dimension in chain >>")))
      (wcmatch (cdr (assoc 0 (entget dim))) "*DIMENSION*")
    )
    (progn 
      (setq ss (LS:DIM_CHAIN_DSEL dim))
      (SSSETFIRST ss ss)
    )
  )
  (princ)
)

(defun C:DIMS_SET_LS () 
  (vlax-ldata-put 
    "AI_DIMS"
    "MaxGap"
    (getdist 
      "Enter max. gap between the dimension chains <Press enter to select all>"
    )
  )
  (princ)
)

(princ)


;;;;;;;;;;;;;;;;-utility functions-;;;;;;;;;;;;;;;;;;;
(defun LS:DIM_CHAIN_DSEL (dim / max_gap dims_colinear dims_groups dims_sorted dim_dx 
                          p10 p14 ss e vec COLINEAR DIMS_SORT DIMSSORTED_SPLIT DICTAD 
                          SS2LST LST2SS
                         ) 


  (if (null (assoc "MaxGap" (vlax-ldata-list "AI_DIMS"))) 
    (vlax-ldata-put "AI_DIMS" "MaxGap" 0.001)
  )
  (setq max_gap (vlax-ldata-get "AI_DIMS" "MaxGap"))
  (setq dim_dx (entget dim))
  (if 
    (setq ss (ssget "_A" 
                    (list '(0 . "DIMENSION") 
                          (assoc 3 dim_dx)
                          (assoc 8 dim_dx)
                    )
             )
    )

    (progn 
      (LS:DIM_LOAD_UTILS)

      (setq p14 (cdr (assoc 14 dim_dx))
            p10 (cdr (assoc 10 dim_dx))
            vec (polar p10 (+ (angle p14 p10) (/ pi 2)) 10)
      )
      (setq dims_colinear (vl-remove-if-not 
                            '(lambda (e) 
                               (COLINEAR 
                                 p10
                                 vec
                                 (cdr (assoc 10 (entget e)))
                                 0.001
                               )
                             )
                            (SS2LST ss)
                          )
      )
      (if (and max_gap (< 2 (length dims_colinear))) 
        (progn 
          (setq dims_sorted (DIMS_SORT dims_colinear vec))

          (setq dims_groups (DIMSSORTED_SPLIT dims_sorted max_gap))
          (LST2SS 
            (car 
              (vl-remove-if-not 
                '(lambda (le) (member dim le))
                dims_groups
              )
            )
          )
        )
        (LST2SS dims_colinear)
      )
    )
  )
)

(defun LS:DIM_LOAD_UTILS () 

  (defun COLINEAR (p1 p2 p3 fuzz / d12 d13 d23) 
    (setq d12 (distance p1 p2)
          d13 (distance p1 p3)
          d23 (distance p2 p3)
    )
    (or 
      (equal (+ d12 d23) d13 fuzz)
      (equal (+ d13 d23) d12 fuzz)
      (equal (+ d12 d13) d23 fuzz)
    )
  )

  (defun DIMSSORTED_SPLIT (dims_sorted max_gap / c cr1 cr2 res) 
    (setq c 0)
    (while (cadr dims_sorted) 
      (setq cr1 (car dims_sorted)
            cr2 (car (setq dims_sorted (cdr dims_sorted)))
      )

      (if (equal (nth 2 cr1) (nth 1 cr2) max_gap) 
        (setq res (DICTAD res (list (cons c (list (car cr1) (car cr2))))))
        (setq c (1+ c))
      )
    )
    (mapcar 'cdr res)
  )


  (defun DIMS_SORT (dims vec) 
    (vl-sort 
      (mapcar 
        '(lambda (e) 
           (cons 
             e
             (vl-sort 
               (list 
                 (nth 2 (trans (cdr (assoc 13 (entget e))) 0 vec))
                 (nth 2 (trans (cdr (assoc 14 (entget e))) 0 vec))
               )
               '<
             )
           )
         )
        dims
      )
      '(lambda (ese1 ese2) (< (cadr ese1) (cadr ese2)))
    )
  )

  (defun DICTAD (dict key_val / pair key val) 
    (if (not dict) 
      (setq dict '())
    )
    (foreach kv key_val 
      (setq key (car kv)
            val (cdr kv)
      )
      (if (/= (type val) 'LIST) 
        (setq val (list val))
      )

      (setq pair (assoc key dict))
      (if pair 
        (setq dict (subst (cons (car pair) (append (cdr pair) val)) 
                          pair
                          dict
                   )
        )

        (setq dict (append dict (list (cons key val))))
      )
    )
    dict
  )

  (defun SS2LST (ss / e lst i) 
    (if (and ss (/= 0 (setq i (SSLENGTH ss)))) 
      (repeat i 
        (setq e (ssname ss (setq i (1- i))))
        (setq lst (cons e lst))
      )
    )
    (reverse lst)
  )

  (defun LST2SS (lst / e ss) 
    (setq ss (ssadd))
    (foreach e lst 
      (if (= 'VLA-OBJECT (type e)) 
        (setq e (handent (vlax-get e 'handle)))
      )
      (ssadd e ss)
    )
    ss
  )
)
;;End LOAD_UTILS



;;;EOF

Similar Attribute Value

Once a dynamic parameter is changed in a dynamic block, the default command SELECTSIMILAR won’t work. So this is a workaround to select dynamic blocks by name.

It also features a command to select blocks by specific attribute value. This works in cascade so you can filter the resulting selection by picking another attribute.
Commands:

DYNBLOCK_SIMILAR – Selects all the dynamic blocks with the same name.
ATTVAL_SIMILAR – Selects all the blocks with the same attribute value by picking the block attribute.

Download tool

AutoLISP code

Lisp

(vl-load-com)

  (princ 
    (strcat 
      “\nProgram to select dynamic blocks by name”
      “\nCommands: ”
      “\nDYNBLOCK_SIMILAR  – Selects all dynamic blocks with the same name. Once a dynamic parameter is changed in a block the default SELECTSIMILAR won’t work.”
      “\nATTVAL_SIMILAR – Selects all blocks with the same attribute value. ”
      “\n\t\t\t\t\t\t\t\tWorks in cascade so you can filter the resulting selection by picking another attribute.”
      “\n(c) ”
      (substr (rtos (getvar “CDATE”) 2 0) 1 4)
      ” lisp-solutions.com”
    )
  )
  (princ)



(defun C:DYNBLOCK_SIMILAR (/ bname blk ss i e) 
  (if 
    (and 
      (if 
        (and (setq ss (ssget “_A” ‘((0 . “INSERT”)))) 
             (setq ss (LS:SS_VISIBLE ss))
        )
        t
        (progn 
          (princ “\nNo blocks in the drawing.”)
          nil
        )
      )
      (if 
        (and (setq blk (car (entsel “\nPick block>>”))) 
             (eq “INSERT” (cdr (assoc 0 (entget blk)))) ;;; npad
        )
        (setq bname (getpropertyvalue blk “BlockTableRecord/Name”))
        (progn 
          (princ “\nNo block selected”)
          nil
        )
      )
    )


    (repeat (setq i (SSLENGTH ss)) 
      (setq e (ssname ss (setq i (1- i))))
      (if (/= bname (getpropertyvalue e “BlockTableRecord/Name”)) 
        (setq ss (ssdel e ss))
      )
    )
  )

  (if (and ss (zerop i)) 
    (progn 
      (SSSETFIRST ss ss)
      (princ (strcat “\n” (itoa (SSLENGTH ss)) ” blocks found”))
    )
    (princ “\nNo blocks found.”)
  )

  (princ)
)


(defun C:ATTVAL_SIMILAR (/ bname blk ss i e att att_dx att_key att_val) 
  (if 
    (and 
      (if
	(cond ((setq ss (ssget “_I” ‘((0 . “INSERT”)))))
	      ((and (setq ss (ssget “_A” ‘((0 . “INSERT”))))
		    (setq ss (LS:SS_VISIBLE ss))
	       )
	      )
	)
        t
        (progn 
          (princ “\nNo blocks in the drawing.”)
          nil
        )
      )
      (if (setq att (car (nentsel “\nPick block attribute>>”))) 
        (progn 
          (setq att_dx (entget att))
          (setq att_key (cdr (assoc 2 att_dx)))
          (setq att_val (cdr (assoc 1 att_dx)))
        )
        (progn 
          (princ “\nNo attribute selected”)
          nil
        )
      )

      (if (setq blk (cdr (assoc 330 att_dx))) 
        (setq bname (getpropertyvalue blk “BlockTableRecord/Name”))
        (progn 
          (princ “\nThe selected attribute has no parent”)
          nil
        )
      )
    )

    (repeat (setq i (SSLENGTH ss)) 
      (setq e (ssname ss (setq i (1- i))))
      (if 
        (or 
          (/= bname (getpropertyvalue e “BlockTableRecord/Name”))
          (/= att_val (getpropertyvalue e att_key))
        )
        (setq ss (ssdel e ss))
      )
    )
  )
  (if (and ss att_key att_val (zerop i)) 
    (progn 
      (SSSETFIRST ss ss)
      (princ 
        (strcat “\nFound ” 
                (itoa (SSLENGTH ss))
                ” blocks with ”
                att_key
                ” = ”
                att_val
        )
      )
    )
    (princ “\nNo blocks found.”)
  )

  (princ)
)

(defun LS:SS_VISIBLE (ss / ss_res la e i) 
  (setq ss_res (ssadd))
  (repeat (setq i (sslength ss)) 
    (setq e (ssname ss (setq i (1- i))))
    (setq la (tblsearch “LAYER” (cdr (assoc 8 (entget e)))))
    (if (< 0 (cdr (assoc 62 la))) 
      (setq ss_res (ssadd e ss_res))
    )
  )
  ss_res
)


;;;EOF

(vl-load-com)

  (princ 
    (strcat 
      "\nProgram to select dynamic blocks by name"
      "\nCommands: "
      "\nDYNBLOCK_SIMILAR  - Selects all dynamic blocks with the same name. Once a dynamic parameter is changed in a block the default SELECTSIMILAR won't work."
      "\nATTVAL_SIMILAR - Selects all blocks with the same attribute value. "
      "\n\t\t\t\t\t\t\t\tWorks in cascade so you can filter the resulting selection by picking another attribute."
      "\n(c) "
      (substr (rtos (getvar "CDATE") 2 0) 1 4)
      " lisp-solutions.com"
    )
  )
  (princ)



(defun C:DYNBLOCK_SIMILAR (/ bname blk ss i e) 
  (if 
    (and 
      (if 
        (and (setq ss (ssget "_A" '((0 . "INSERT")))) 
             (setq ss (LS:SS_VISIBLE ss))
        )
        t
        (progn 
          (princ "\nNo blocks in the drawing.")
          nil
        )
      )
      (if 
        (and (setq blk (car (entsel "\nPick block>>"))) 
             (eq "INSERT" (cdr (assoc 0 (entget blk)))) ;;; npad
        )
        (setq bname (getpropertyvalue blk "BlockTableRecord/Name"))
        (progn 
          (princ "\nNo block selected")
          nil
        )
      )
    )


    (repeat (setq i (SSLENGTH ss)) 
      (setq e (ssname ss (setq i (1- i))))
      (if (/= bname (getpropertyvalue e "BlockTableRecord/Name")) 
        (setq ss (ssdel e ss))
      )
    )
  )

  (if (and ss (zerop i)) 
    (progn 
      (SSSETFIRST ss ss)
      (princ (strcat "\n" (itoa (SSLENGTH ss)) " blocks found"))
    )
    (princ "\nNo blocks found.")
  )

  (princ)
)


(defun C:ATTVAL_SIMILAR (/ bname blk ss i e att att_dx att_key att_val) 
  (if 
    (and 
      (if
	(cond ((setq ss (ssget "_I" '((0 . "INSERT")))))
	      ((and (setq ss (ssget "_A" '((0 . "INSERT"))))
		    (setq ss (LS:SS_VISIBLE ss))
	       )
	      )
	)
        t
        (progn 
          (princ "\nNo blocks in the drawing.")
          nil
        )
      )
      (if (setq att (car (nentsel "\nPick block attribute>>"))) 
        (progn 
          (setq att_dx (entget att))
          (setq att_key (cdr (assoc 2 att_dx)))
          (setq att_val (cdr (assoc 1 att_dx)))
        )
        (progn 
          (princ "\nNo attribute selected")
          nil
        )
      )

      (if (setq blk (cdr (assoc 330 att_dx))) 
        (setq bname (getpropertyvalue blk "BlockTableRecord/Name"))
        (progn 
          (princ "\nThe selected attribute has no parent")
          nil
        )
      )
    )

    (repeat (setq i (SSLENGTH ss)) 
      (setq e (ssname ss (setq i (1- i))))
      (if 
        (or 
          (/= bname (getpropertyvalue e "BlockTableRecord/Name"))
          (/= att_val (getpropertyvalue e att_key))
        )
        (setq ss (ssdel e ss))
      )
    )
  )
  (if (and ss att_key att_val (zerop i)) 
    (progn 
      (SSSETFIRST ss ss)
      (princ 
        (strcat "\nFound " 
                (itoa (SSLENGTH ss))
                " blocks with "
                att_key
                " = "
                att_val
        )
      )
    )
    (princ "\nNo blocks found.")
  )

  (princ)
)

(defun LS:SS_VISIBLE (ss / ss_res la e i) 
  (setq ss_res (ssadd))
  (repeat (setq i (sslength ss)) 
    (setq e (ssname ss (setq i (1- i))))
    (setq la (tblsearch "LAYER" (cdr (assoc 8 (entget e)))))
    (if (< 0 (cdr (assoc 62 la))) 
      (setq ss_res (ssadd e ss_res))
    )
  )
  ss_res
)


;;;EOF

Move at calculated distance

Moves a set of objects such as the selection will be at a given ortho distance from a reference point to a given point. Points can be picked in any order but one of them must be on an object in the selection.

Command:

MOVE_ORTHO_FIX

Download tool

AutoLISP code

Lisp


(princ 
  (strcat 
    "\nProgram to move objects at calculated ortho distance."
    "\nMoves as such as the selection will be at the desired distance to a given point. "
    "\nOptimized for any custom UCS"
    "\nCommand: "
    "\nMOVE_ORTHO_FIX"

    "\n(c) "
    (substr (rtos (getvar "CDATE") 2 0) 1 4)
    " lisp-solutions.com"
  )
)
(defun C:MOVE_ORTHO_FIX (/ ddist dpoint fdist mine ob1 olddist other p1 p2 sign ss 
                         vec0 xy
                        ) 
  (setq ss (cadr (SSGETFIRST)))
  (if (not ss) 
    (setq ss (ssget))
  )

  (setq p1 (GETPOINT "\nInitial distance>>"))
  (setq p2 (GETPOINT "\n>>" p1))

  (setq ob1 (nentselp p1))
  (setq ob1 (if (= 2 (length ob1)) 
              (car ob1)
              (car (last ob1)) ; if block
            )
  )

  (if (SSMEMB ob1 ss) 
    (setq mine  p1
          other p2
    )
    (setq mine  p2
          other p1
    )
  )

  (setq vec0 (mapcar '- p1 p2))
  (setq vec0 (mapcar 'abs (list (car vec0) (cadr vec0))))
  (setq xy (vl-position (apply 'max vec0) vec0)) ; x or y
  (setq oldDist (abs (- (nth xy mine) (nth xy other)))) ;ortho distance
  (setq sign (if (> (nth xy mine) (nth xy other)) 
               1
               -1
             )
  )
  (setq fdist (getdist 
                (strcat "\nDesired distance <Actual ortho distance = " 
                        (rtos oldDist 2 2)
                        ">:"
                )
              )
  )

  (setq ddist (* sign (- fdist oldDist)))
  (setq dpoint (if (= xy 0) 
                 (list ddist 0)
                 (list 0 ddist)
               )
  )
  (COMMAND "_MOVE" ss "" "_D" dpoint)
)

Auto number title-block sheet number

This program numbers/renumbers the sheets in all the layouts.

It uses the layouts order to determine the numbering sequence, so make sure the layouts are in the desired order . Useful when new sheets are inserted or removed.
Commands:

LAYOUTS_AUTO_NR -Pick the sheet number attribute in the title-block in one of the layouts and then enter the optional parameters (prefix and count start)

Download tool

AutoLISP code

Lisp

;;;This program numbers/renumbers the sheets in all the layouts.
;;;It uses the layouts order to determine the numbering sequence, so make sure the layouts are in ;;;the desired order . Useful when new sheets are inserted or removed.
;;;Use: Pick the sheet number attribute in the title-block  in one of the layouts and then enter ;;;the optional parameters (prefix and count start)

(vl-load-com)

(princ
  (strcat
    “\nProgram to auto-number block attributes in each layout in sequence with respect to layouts order.”
    “\nCommands: ”
    “\nLAYOUTS_AUTO_NR – Auto-number block attributes in each layout.”
    “\n(c) ”
    (substr (rtos (getvar “CDATE”) 2 0) 1 4)
    ” lisp-solutions.com”
  )
)
(princ)


(defun C:LAYOUTS_AUTO_NR (/	  att	  att_dx  blk	  blkname
			  bname	  doc	  ln	  offset  prefix
			  tag	  atts
			 )

  (if
    (and
      (setq
	att (car (nentsel “\nPick block attribute to autonumber>>”))
      )
      (setq att_dx (entget att))
      (= “ATTRIB” (cdr (assoc 0 att_dx)))
      (setq blk (cdr (assoc 330 att_dx)))
    )
     (progn
       (setq doc (vla-get-activedocument (vlax-get-acad-object)))
       (setq prefix (cond
		      ((getstring “\nPrefix:” t))
		      (t “”)
		    )
       )
       (setq offset (cond
		      ((getint “\nCount starts from:”))
		      (t 0)
		    )
       )
       (setq bname (getpropertyvalue blk “BlockTableRecord/Name”))
       (setq tag (cdr (assoc 2 att_dx)))
       (vlax-for lay (vla-get-layouts doc)
	 (if (/= “Model” (vlax-get lay ‘Name))
	   (progn
	     (setq ln (vla-get-TabOrder lay))
	     (vlax-for ob (vlax-get lay ‘Block)
	       (if
		 (and (= “AcDbBlockReference” (vla-get-ObjectName ob))
		      (= bname
			 (getpropertyvalue
			   (vlax-vla-object->ename ob)
			   “BlockTableRecord/Name”
			 )
		      )
		      (= :vlax-true (vla-get-HasAttributes ob))
		      (setq atts (vlax-invoke ob ‘GetAttributes))
		 )

		  (foreach att atts
		    (if
		      (= tag
			 (vlax-get att ‘TagString)
		      )
		       (vlax-put att
				 ‘TextString
				 (strcat prefix (itoa (+ offset ln -1)))
		       )
		    )
		  )
	       )
	     )
	   )
	 )
       )
     )
  )

  (if (and doc (not (vlax-object-released-p doc)))
    (vlax-release-object doc)
  )
  (princ)
)

;;EOF

;;;This program numbers/renumbers the sheets in all the layouts.
;;;It uses the layouts order to determine the numbering sequence, so make sure the layouts are in ;;;the desired order . Useful when new sheets are inserted or removed.
;;;Use: Pick the sheet number attribute in the title-block  in one of the layouts and then enter ;;;the optional parameters (prefix and count start)

(vl-load-com)

(princ
  (strcat
    "\nProgram to auto-number block attributes in each layout in sequence with respect to layouts order."
    "\nCommands: "
    "\nLAYOUTS_AUTO_NR - Auto-number block attributes in each layout."
    "\n(c) "
    (substr (rtos (getvar "CDATE") 2 0) 1 4)
    " lisp-solutions.com"
  )
)
(princ)


(defun C:LAYOUTS_AUTO_NR (/	  att	  att_dx  blk	  blkname
			  bname	  doc	  ln	  offset  prefix
			  tag	  atts
			 )

  (if
    (and
      (setq
	att (car (nentsel "\nPick block attribute to autonumber>>"))
      )
      (setq att_dx (entget att))
      (= "ATTRIB" (cdr (assoc 0 att_dx)))
      (setq blk (cdr (assoc 330 att_dx)))
    )
     (progn
       (setq doc (vla-get-activedocument (vlax-get-acad-object)))
       (setq prefix (cond
		      ((getstring "\nPrefix:" t))
		      (t "")
		    )
       )
       (setq offset (cond
		      ((getint "\nCount starts from:"))
		      (t 0)
		    )
       )
       (setq bname (getpropertyvalue blk "BlockTableRecord/Name"))
       (setq tag (cdr (assoc 2 att_dx)))
       (vlax-for lay (vla-get-layouts doc)
	 (if (/= "Model" (vlax-get lay 'Name))
	   (progn
	     (setq ln (vla-get-TabOrder lay))
	     (vlax-for ob (vlax-get lay 'Block)
	       (if
		 (and (= "AcDbBlockReference" (vla-get-ObjectName ob))
		      (= bname
			 (getpropertyvalue
			   (vlax-vla-object->ename ob)
			   "BlockTableRecord/Name"
			 )
		      )
		      (= :vlax-true (vla-get-HasAttributes ob))
		      (setq atts (vlax-invoke ob 'GetAttributes))
		 )

		  (foreach att atts
		    (if
		      (= tag
			 (vlax-get att 'TagString)
		      )
		       (vlax-put att
				 'TextString
				 (strcat prefix (itoa (+ offset ln -1)))
		       )
		    )
		  )
	       )
	     )
	   )
	 )
       )
     )
  )

  (if (and doc (not (vlax-object-released-p doc)))
    (vlax-release-object doc)
  )
  (princ)
)

;;EOF