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.
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