;;; ---------------------------------------------------------------------------
;;; DimClash.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Finds dimensions that OVERLAP each other and moves them to a dedicated
;;; layer so they stand out.
;;;
;;; This is a pre-issue QA check. Two dimensions sitting on top of one another
;;; are unreadable at plot size but look perfectly fine on screen at working
;;; zoom - so they routinely survive all the way to the printed sheet, where
;;; the contractor cannot read either figure.
;;;
;;; Press Enter at the prompt and the WHOLE drawing is checked - every layout
;;; and every block definition, so dimensions buried inside blocks are found
;;; too. Or select specific dimensions to check just those.
;;;
;;; Offending dimensions are moved to a DIMOVERLAP layer, created red and
;;; continuous, so they are immediately obvious. Nothing is deleted and nothing
;;; is moved in space - only the layer changes, so a single UNDO reverses the
;;; whole check.
;;;
;;; HOW OVERLAP IS DETECTED
;;; Each dimension is reduced to the LINE ITS DIMENSION TEXT SITS ON - not its
;;; extension lines or its measured points. That line is derived from the
;;; dimension line point (DXF 10) and the definition points (13 and 14) by
;;; projecting perpendicular from the measured run.
;;;
;;; Two dimensions clash when those lines lie along one another and their
;;; extents overlap. Both the case of shared endpoints and the case of one line
;;; running through another are tested, which is what lets it catch dimensions
;;; overlapping from either side.
;;;
;;; Only linear and aligned dimensions are checked. Radial, angular and ordinate
;;; dimensions have no comparable dimension line and are excluded by the
;;; selection filter's list of DXF 70 values.
;;;
;;;   DIMCLASH  - find and flag overlapping dimensions
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; SETTINGS
;;; ---------------------------------------------------------------------------

;; How close two dimension lines must be to count as overlapping. Raise it if
;; dimensions that visibly clash are not being reported; lower it if unrelated
;; dimensions are being flagged.
(setq DimClash:Tolerance 0.01)

;; The layer offending dimensions are moved to, and its properties. The layer
;; is created if it does not exist and reset to these values if it does.
(setq DimClash:Layer
   '(
        (002 . "DIMOVERLAP")   ; layer name
        (062 .  1)             ; colour, 1 = red
        (006 . "Continuous")   ; linetype - must already be loaded
        (370 . -3)             ; lineweight, -3 = default
    )
)

;; ---------------------------------------------------------------------------
;; The DXF 70 values accepted by the selection filter. Bit 0 selects rotated
;; and bit 1 aligned dimensions; the higher bits are the flags for user-defined
;; text position, ordinate type and so on, so every combination that still
;; describes a linear or aligned dimension has to be listed explicitly.
;; ---------------------------------------------------------------------------
(setq DimClash:Filter
   '(
        (0 . "DIMENSION")
        (-4 . "<OR")
            (70 . 000) (70 . 001) (70 . 032) (70 . 033)
            (70 . 064) (70 . 065) (70 . 096) (70 . 097)
            (70 . 128) (70 . 129) (70 . 160) (70 . 161)
            (70 . 192) (70 . 193) (70 . 224) (70 . 225)
        (-4 . "OR>")
    )
)

;; ---------------------------------------------------------------------------
;; DimClash:Doc  -  cached active document
;; ---------------------------------------------------------------------------
(defun DimClash:Doc nil
    (eval (list 'defun 'DimClash:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (DimClash:Doc)
)

;; ---------------------------------------------------------------------------
;; DimClash:LineOf
;; ---------------------------------------------------------------------------
;; Reduces a dimension to the two endpoints of the line its text sits on,
;; returning (start end entityData) or nil if it cannot be reduced.
;;
;; The three groups used:
;;   10  a point on the dimension line
;;   13  first definition point - one end of what is measured
;;   14  second definition point - the other end
;;
;; The vector from 10 to 14 is the offset direction. Intersecting a line
;; perpendicular to it through point 10 with a line parallel to it through
;; point 13 gives the far end of the dimension line - so the two returned
;; points span exactly the run the dimension text occupies.
;;
;; A dimension whose points 10 and 14 coincide has no meaningful direction and
;; is skipped.
;; ---------------------------------------------------------------------------
(defun DimClash:LineOf ( enx / g10 g13 g14 int ocs vec )
    (setq ocs (cdr (assoc 210 enx))
          g10 (trans (cdr (assoc 10 enx)) 0 ocs)
          g13 (trans (cdr (assoc 13 enx)) 0 ocs)
          g14 (trans (cdr (assoc 14 enx)) 0 ocs)
    )
    (cond
        (   (equal g10 g14 1e-8)
            nil
        )
        (   (setq vec (mapcar '- g10 g14)
                  int (inters
                          ;; Perpendicular through g10: rotating (x y) by 90
                          ;; degrees gives (-y x).
                          g10 (mapcar '+ g10 (list (- (cadr vec)) (car vec) 0.0))
                          ;; Parallel to the offset, through g13.
                          g13 (mapcar '+ g13 vec)
                          nil                       ; extend both lines infinitely
                      )
            )
            (list g10 int enx)
        )
    )
)

;; ---------------------------------------------------------------------------
;; DimClash:OnLine
;; ---------------------------------------------------------------------------
;; True if point p lies strictly BETWEEN a and b, within tolerance.
;;
;; The test is that the distance a-to-b equals the distance a-to-p plus p-to-b:
;; true only when p is on the segment. The two equality checks first exclude p
;; coinciding with either endpoint, since dimensions that merely touch end to
;; end are not overlapping.
;; ---------------------------------------------------------------------------
(defun DimClash:OnLine ( p a b tol )
    (and (not (equal a p tol))
         (not (equal b p tol))
         (equal (distance a b) (+ (distance a p) (distance b p)) tol)
    )
)

;; ---------------------------------------------------------------------------
;; DimClash:Flag
;; ---------------------------------------------------------------------------
;; Moves a dimension to the flag layer by substituting its DXF group 8.
;; ---------------------------------------------------------------------------
(defun DimClash:Flag ( enx lay )
    (entmod (subst (cons 8 lay) (assoc 8 enx) enx))
)

;; ---------------------------------------------------------------------------
;; DimClash:Check
;; ---------------------------------------------------------------------------
;; Compares every dimension line against every other and flags the clashes.
;; Returns how many were flagged.
;;
;; The outer loop takes each dimension in turn and the inner compares it
;; against only those still ahead of it in the list - so each pair is tested
;; once rather than twice.
;;
;; Two overlap conditions are tested per pair:
;;
;;   1. They share an endpoint AND the other end of one lies along the other.
;;      This catches dimensions running in the same direction from a common
;;      point, one shorter than the other.
;;
;;   2. Each line has an endpoint lying strictly within the other. This catches
;;      dimensions that straddle one another, and both are flagged since
;;      neither is more at fault than the other.
;;
;; The four argument lists to vl-some feed the endpoint pairs through in every
;; combination needed to test both directions of both dimensions.
;;
;; lst - [list] the reduced dimension lines
;; lay - [str] flag layer name
;; tol - [real] comparison tolerance
;; ---------------------------------------------------------------------------
(defun DimClash:Check ( lst lay tol / cnt dm1 dm2 tmp )
    (setq cnt 0)
    (while (setq dm1 (car lst))
        (setq lst (cdr lst)
              tmp lst
        )
        (while
            (not
                (or (null (setq dm2 (car tmp)))
                    (vl-some
                        (function
                            (lambda ( a b c d )
                                (cond
                                    ;; Condition 1 - a shared endpoint.
                                    (   (equal a c tol)
                                        (cond
                                            (   (DimClash:OnLine b c d tol)
                                                (DimClash:Flag (caddr dm2) lay)
                                                (setq cnt (1+ cnt))
                                            )
                                            (   (DimClash:OnLine d a b tol)
                                                (DimClash:Flag (caddr dm1) lay)
                                                (setq cnt (1+ cnt))
                                            )
                                        )
                                    )
                                    ;; Condition 2 - mutually straddling.
                                    (   (and (DimClash:OnLine c a b tol)
                                             (DimClash:OnLine a c d tol)
                                        )
                                        (foreach dim (list dm1 dm2)
                                            (DimClash:Flag (caddr dim) lay)
                                            (setq cnt (1+ cnt))
                                        )
                                    )
                                )
                            )
                        )
                        (list (car  dm1) (car  dm1) (cadr dm1) (cadr dm1))
                        (list (cadr dm1) (cadr dm1) (car  dm1) (car  dm1))
                        (list (car  dm2) (cadr dm2) (car  dm2) (cadr dm2))
                        (list (cadr dm2) (car  dm2) (cadr dm2) (car  dm2))
                    )
                )
            )
            (setq tmp (cdr tmp))
        )
    )
    cnt
)

;; ---------------------------------------------------------------------------
;; DimClash:FromSelection
;; ---------------------------------------------------------------------------
;; Checks the dimensions in a selection set. Returns the count flagged.
;;
;; Note that the original left its loop index undeclared, leaking it globally
;; on every run; it is localised here.
;; ---------------------------------------------------------------------------
(defun DimClash:FromSelection ( sel lay tol / idx itm lst )
    (repeat (setq idx (sslength sel))
        (if (setq itm (DimClash:LineOf (entget (ssname sel (setq idx (1- idx))))))
            (setq lst (cons itm lst))
        )
    )
    (DimClash:Check lst lay tol)
)

;; ---------------------------------------------------------------------------
;; DimClash:FromBlock
;; ---------------------------------------------------------------------------
;; Checks the dimensions within one block definition - which, since every
;; layout is itself a block, is how the whole-drawing sweep covers both layouts
;; and nested content.
;; ---------------------------------------------------------------------------
(defun DimClash:FromBlock ( blk lay tol / itm lst )
    (vlax-for obj blk
        (if (and (wcmatch (vla-get-objectname obj)
                          "AcDbRotatedDimension,AcDbAlignedDimension")
                 (setq itm (DimClash:LineOf (entget (vlax-vla-object->ename obj))))
            )
            (setq lst (cons itm lst))
        )
    )
    (DimClash:Check lst lay tol)
)

;; ---------------------------------------------------------------------------
;; DimClash:Run
;; ---------------------------------------------------------------------------
;; Performs the check and reports. A pickset checks just that selection; nil
;; sweeps the whole drawing.
;; ---------------------------------------------------------------------------
(defun DimClash:Run ( sel / lay tol inLayouts inBlocks total ent )

    (setq lay       (cdr (assoc 2 DimClash:Layer))
          tol       DimClash:Tolerance
          inLayouts 0
          inBlocks  0
    )

    (if (= 'pickset (type sel))
        (setq inLayouts (DimClash:FromSelection sel lay tol))
        ;; Whole drawing. Every layout and every block definition is a member
        ;; of the BLOCKS collection, so one pass over it covers both - the
        ;; IsLayout property separates the two counts for reporting. Xrefs are
        ;; skipped, since their content belongs to another drawing.
        (vlax-for blk (vla-get-blocks (DimClash:Doc))
            (if (= :vlax-false (vla-get-isxref blk))
                (if (= :vlax-true (vla-get-islayout blk))
                    (setq inLayouts (+ inLayouts (DimClash:FromBlock blk lay tol)))
                    (setq inBlocks  (+ inBlocks  (DimClash:FromBlock blk lay tol)))
                )
            )
        )
    )

    ;; Dimensions changed inside block definitions need a regen to show.
    (if (< 0 inBlocks)
        (vla-regen (DimClash:Doc) acallviewports)
    )

    (setq total (+ inLayouts inBlocks))

    (if (< 0 total)
        (progn
            ;; Apply the configured properties to the flag layer. It will exist
            ;; by now, since moving a dimension onto it creates it.
            (if (setq ent (tblobjname "layer" lay))
                (entmod
                    (vl-list*
                        (cons -1 ent)
                       '(000 . "LAYER")
                       '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbLayerTableRecord")
                       '(070 . 0)
                        DimClash:Layer
                    )
                )
            )
            (princ
                (strcat "\n" (itoa total) " overlapping dimension"
                        (if (= 1 total) " was" "s were")
                        " found and moved to the \"" lay "\" layer."
                        (if (< 0 inBlocks)
                            (strcat "\n" (itoa inBlocks)
                                    (if (= 1 inBlocks) " was inside a block." " were inside blocks.")
                            )
                            ""
                        )
                )
            )
        )
        (princ "\nNo overlapping dimensions were found.")
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:DIMCLASH  -  main routine
;; ---------------------------------------------------------------------------
(defun c:DIMCLASH ( / *error* vars vals sel )

    (setq vars '("CMDECHO" "NOMUTT")
          vals (mapcar 'getvar vars)
    )

    (defun DimClash:Restore ( )
        ;; Restored to the CAPTURED value; the original reset NOMUTT to a
        ;; hard-coded 0, clobbering any non-default setting.
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (princ)
    )

    (defun *error* ( msg )
        (DimClash:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** DIMCLASH error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
    ;; unless the routine says up front that it will use one. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    ;; NOMUTT suppresses the built-in selection chatter so the custom "<All>"
    ;; prompt is the only thing shown.
    (princ "\nSelect dimensions to check <All>: ")
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget (list DimClash:Filter)))
    (setvar 'nomutt (cadr vals))

    ;; A caught error means the user pressed Escape; a nil result means they
    ;; pressed Enter, which is the request to sweep the whole drawing.
    (if (vl-catch-all-error-p sel)
        (princ "\n*Cancelled*")
        (DimClash:Run sel)
    )

    (DimClash:Restore)
    (princ)
)

(princ)