(defun c:autodim ( / *error* gc:UcsBoundingBox gc:TMatrixFromTo lwichk linarc2dim osm cmd ch p d sel sdim pl1 pl2 si ee e x oo lwi lll llp urp ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun *error* ( m ) (if (and lwi (not (vlax-erased-p lwi))) (entdel lwi) ) (while (= 8 (logand 8 (getvar (quote undoctl)))) (if command-s (command-s "_.undo" "_e") (vl-cmdf "_.undo" "_e") ) ) (if osm (setvar (quote osmode) osm) ) (if cmd (setvar (quote cmdecho) cmd) ) (if m (prompt m) ) (princ) ) ;; gc:UcsBoundingBox by Gile ;; Returns the UCS coordinates of the object bounding box about current UCS ;; ;; Arguments ;; obj: an entity (ENAME or VLA-OBJCET) ;; _OutputMinPtSym: a quoted symbol (output) ;; _OutputMaxPtSym: a quoted symbol (output) (defun gc:UcsBoundingBox ( obj _OutputMinPtSym _OutputMaxPtSym ) (and (= (type obj) (quote ename)) (setq obj (vlax-ename->vla-object obj)) ) (vla-transformby obj (vlax-tmatrix (gc:TMatrixFromTo 1 0))) (vla-getboundingbox obj _OutputMinPtSym _OutputMaxPtSym) (vla-transformby obj (vlax-tmatrix (gc:TMatrixFromTo 0 1))) (set _OutputMinPtSym (safearray-value (eval _OutputMinPtSym))) (set _OutputMaxPtSym (safearray-value (eval _OutputMaxPtSym))) ) ;; gc:TMatrixFromTo by Gile ;; Returns the 4X4 transformation matrix from a coordinate system to an other one ;; ;; Arguments ;; from to: same arguments as for the 'trans' function (defun gc:TMatrixFromTo ( from to ) (append (mapcar (function (lambda ( v o ) (append (trans v from to t) (list o)) ) ) '( (1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0) ) (trans '(0.0 0.0 0.0) to from) ) '((0.0 0.0 0.0 1.0)) ) ) (defun lwichk ( arc lwi / x xx fordel mpa ) (setq x (entlast)) (if (vlax-method-applicable-p (vlax-ename->vla-object lwi) (quote explode)) (vla-explode (vlax-ename->vla-object lwi)) ) (while (setq x (entnext x)) (setq xx (cons x xx)) ) (setq fordel xx) (if xx (progn (setq xx (vl-remove-if-not (function (lambda ( w ) (= (cdr (assoc 0 (entget w))) "ARC"))) xx)) (setq mpa (trans (vlax-curve-getpointatparam arc (/ (+ (vlax-curve-getstartparam arc) (vlax-curve-getendparam arc)) 2.0)) 0 1)) (setq x (car (vl-sort xx (function (lambda ( a b ) (< (distance mpa (trans (vlax-curve-getpointatparam a (/ (+ (vlax-curve-getstartparam a) (vlax-curve-getendparam a)) 2.0)) 0 1)) (distance mpa (trans (vlax-curve-getpointatparam b (/ (+ (vlax-curve-getstartparam b) (vlax-curve-getendparam b)) 2.0)) 0 1)))))))) (list x fordel) ) ) ) (defun linarc2dim ( e spc lwi d / x p1 p2 p3 pp c ll elev dimrad ) (cond ( (= (cdr (assoc 0 (setq x (entget e)))) "LINE") (setq p1 (trans (cdr (assoc 10 x)) 0 1)) (setq p2 (trans (cdr (assoc 11 x)) 0 1)) (cond ( (< (car p2) (car p1)) (mapcar (function set) (list (quote p1) (quote p2)) (list p2 p1)) ) ( (< (cadr p2) (cadr p1)) (mapcar (function set) (list (quote p1) (quote p2)) (list p2 p1)) ) ) (vla-adddimaligned spc (vlax-3d-point (trans p1 1 0)) (vlax-3d-point (trans p2 1 0)) (vlax-3d-point (trans (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2) 1 0))) (ssadd (entlast) sdim) ) ( (= (cdr (assoc 0 x)) "ARC") (setq p1 (vlax-curve-getstartpoint e)) (setq p2 (vlax-curve-getpointatparam e (/ (+ (vlax-curve-getstartparam e) (vlax-curve-getendparam e)) 2.0))) (setq pp (vlax-curve-getpointatparam e (+ (vlax-curve-getstartparam e) (/ (- (vlax-curve-getendparam e) (vlax-curve-getstartparam e)) 3.0)))) (setq p3 (vlax-curve-getendpoint e)) (setq c (vlax-get (vlax-ename->vla-object e) (quote center))) (if lwi (setq ll (lwichk e lwi)) ) (if (and (car ll) (vlax-erased-p (car ll))) (entdel (car ll)) ) (cond ( (and lwi (< (distance c p1) (distance c (vlax-curve-getclosestpointto (car ll) p1)))) (foreach x (cadr ll) (if (and x (not (vlax-erased-p x))) (entdel x) ) ) (if (and (car ll) (not (vlax-erased-p (car ll)))) (entdel (car ll)) ) (vla-adddimarc spc (vlax-3d-point c) (vlax-3d-point p1) (vlax-3d-point p3) (vlax-3d-point (polar p2 (angle p2 c) d))) (ssadd (entlast) sdim) (vla-adddim3pointangular spc (vlax-3d-point c) (vlax-3d-point p1) (vlax-3d-point p3) (vlax-3d-point (polar p2 (angle p2 c) (* 3.0 d)))) (ssadd (entlast) sdim) (setq dimrad (vla-adddimradial spc (vlax-3d-point c) (vlax-3d-point pp) 0.0)) (vla-put-textposition dimrad (vlax-3d-point (polar pp (angle pp c) (* 4.0 d)))) (ssadd (entlast) sdim) ) ( (and lwi (> (distance c p1) (distance c (vlax-curve-getclosestpointto (car ll) p1)))) (foreach x (cadr ll) (if (and x (not (vlax-erased-p x))) (entdel x) ) ) (if (and (car ll) (not (vlax-erased-p (car ll)))) (entdel (car ll)) ) (vla-adddimarc spc (vlax-3d-point c) (vlax-3d-point p1) (vlax-3d-point p3) (vlax-3d-point (polar p2 (angle c p2) d))) (ssadd (entlast) sdim) (vla-adddim3pointangular spc (vlax-3d-point c) (vlax-3d-point p1) (vlax-3d-point p3) (vlax-3d-point (polar p2 (angle c p2) (* 3.0 d)))) (ssadd (entlast) sdim) (setq dimrad (vla-adddimradial spc (vlax-3d-point c) (vlax-3d-point pp) 0.0)) (vla-put-textposition dimrad (vlax-3d-point (polar pp (angle c pp) (* 4.0 d)))) (ssadd (entlast) sdim) ) ( (not lwi) (vla-adddimarc spc (vlax-3d-point c) (vlax-3d-point p1) (vlax-3d-point p3) (vlax-3d-point (polar p2 (angle c p2) d))) (ssadd (entlast) sdim) (vla-adddim3pointangular spc (vlax-3d-point c) (vlax-3d-point p1) (vlax-3d-point p3) (vlax-3d-point (polar p2 (angle c p2) (* 3.0 d)))) (ssadd (entlast) sdim) (setq dimrad (vla-adddimradial spc (vlax-3d-point c) (vlax-3d-point pp) 0.0)) (vla-put-textposition dimrad (vlax-3d-point (polar pp (angle c pp) (* 4.0 d)))) (ssadd (entlast) sdim) ) ) ) ) ) (or cad (setq cad (vlax-get-acad-object))) (or doc (setq doc (vla-get-activedocument cad))) (or alo (setq alo (vla-get-activelayout doc))) (or spc (setq spc (vla-get-block alo))) (setq osm (getvar (quote osmode))) (setvar (quote osmode) 0) (setq cmd (getvar (quote cmdecho))) (setvar (quote cmdecho) 0) (initget "Yes No") (setq ch (cond ( (getkword "\nDo you have 2 offset LWPOLYLINES to dimension (Yes), or multiple LWPOLYLINES,LINES,ARCS (No) [Yes/No] : ") ) ("No"))) (setvar (quote textsize) (* 2.0 (getvar (quote dimasz)))) (while (= 8 (logand 8 (getvar (quote undoctl)))) (vl-cmdf "_.undo" "_e") ) (vl-cmdf "_.undo" "_be") (initget 1) (setq p (getpoint "\nPick or specify internal point : ")) (initget 7) (setq d (getdist p "\nPick or specify offset dimensions distance : ")) (if (cond ( (= ch "Yes") (setq sel (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&=") (cons 70 1)))) (= (sslength sel) 2) ) ( t (setq sel (ssget "_:L" (list (cons 0 "LWPOLYLINE,LINE,ARC")))) ) ) (progn (setq sdim (ssadd)) (vl-cmdf "_.ZOOM" "_E") (if (= ch "No") (foreach pl (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sel))) (setq oo nil lwi nil ee nil) (if (= (cdr (assoc 0 (setq x (entget pl)))) "LWPOLYLINE") (progn (entupd (cdr (assoc -1 (entmod (subst (cons 38 0.0) (assoc 38 x) x))))) (vla-offset (vlax-ename->vla-object pl) -1e-3) (setq lwi (entlast)) (if (> (vlax-curve-getarea lwi) (vlax-curve-getarea pl)) (progn (entdel lwi) (vla-offset (vlax-ename->vla-object pl) 1e-3) (setq lwi (entlast)) (setq si (eval (function +))) ) (setq si (eval (function -))) ) (vla-copy (vlax-ename->vla-object pl)) (setq e (entlast)) (vl-cmdf "_.EXPLODE" "_L") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) (while (setq e (entnext e)) (setq ee (cons e ee)) ) (foreach e ee (cond ( (= (cdr (assoc 0 (setq x (entget e)))) "LINE") (if (vlax-method-applicable-p (vlax-ename->vla-object e) (quote offset)) (progn (vla-offset (vlax-ename->vla-object e) (si d)) (setq oo (cons (entlast) oo)) (entdel e) ) ) ) ( (= (cdr (assoc 0 x)) "ARC") (setq oo (cons e oo)) ) ) ) (foreach o oo (linarc2dim o spc lwi d) (if (and o (not (vlax-erased-p o))) (entdel o) ) ) (if (and lwi (not (vlax-erased-p lwi))) (entdel lwi) ) ) (cond ( (= (cdr (assoc 0 (setq x (entget pl)))) "LINE") (vla-offset (vlax-ename->vla-object pl) d) (setq e (entlast)) (linarc2dim e spc lwi d) (if (and e (not (vlax-erased-p e))) (entdel e) ) ) ( t (linarc2dim pl spc lwi d) ) ) ) ) (progn (setq ee (vl-sort (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sel))) (function (lambda ( a b ) (< (vlax-curve-getarea a) (vlax-curve-getarea b)))))) (setq pl1 (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (car ee))))) (setq x (entget pl1)) (entupd (cdr (assoc -1 (entmod (subst (cons 38 0.0) (assoc 38 x) x))))) (setq pl2 (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (cadr ee))))) (setq x (entget pl2)) (entupd (cdr (assoc -1 (entmod (subst (cons 38 0.0) (assoc 38 x) x))))) (setq oo nil ee nil) (vla-offset (vlax-ename->vla-object pl1) -1e-3) (setq lwi (entlast)) (if (< (vlax-curve-getarea lwi) (vlax-curve-getarea pl1)) (progn (entdel lwi) (vla-offset (vlax-ename->vla-object pl1) 1e-3) (setq lwi (entlast)) (setq si (eval (function +))) ) (setq si (eval (function -))) ) (vla-copy (vlax-ename->vla-object pl1)) (setq e (entlast)) (vl-cmdf "_.EXPLODE" "_L") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) (while (setq e (entnext e)) (setq ee (cons e ee)) ) (foreach e ee (cond ( (= (cdr (assoc 0 (setq x (entget e)))) "LINE") (if (vlax-method-applicable-p (vlax-ename->vla-object e) (quote offset)) (progn (vla-offset (vlax-ename->vla-object e) (si d)) (setq oo (cons (entlast) oo)) (entdel e) ) ) ) ( (= (cdr (assoc 0 x)) "ARC") (setq oo (cons e oo)) ) ) ) (foreach o oo (linarc2dim o spc lwi (- (si d))) (if (and o (not (vlax-erased-p o))) (entdel o) ) ) (if (and pl1 (not (vlax-erased-p pl1))) (entdel pl1) ) (if (and lwi (not (vlax-erased-p lwi))) (entdel lwi) ) (setq oo nil ee nil) (vla-offset (vlax-ename->vla-object pl2) -1e-3) (setq lwi (entlast)) (if (> (vlax-curve-getarea lwi) (vlax-curve-getarea pl2)) (progn (entdel lwi) (vla-offset (vlax-ename->vla-object pl2) 1e-3) (setq lwi (entlast)) (setq si (eval (function +))) ) (setq si (eval (function -))) ) (vla-copy (vlax-ename->vla-object pl2)) (setq e (entlast)) (vl-cmdf "_.EXPLODE" "_L") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) (while (setq e (entnext e)) (setq ee (cons e ee)) ) (foreach e ee (cond ( (= (cdr (assoc 0 (setq x (entget e)))) "LINE") (if (vlax-method-applicable-p (vlax-ename->vla-object e) (quote offset)) (progn (vla-offset (vlax-ename->vla-object e) (si d)) (setq oo (cons (entlast) oo)) (entdel e) ) ) ) ( (= (cdr (assoc 0 x)) "ARC") (setq oo (cons e oo)) ) ) ) (foreach o oo (linarc2dim o spc lwi (- (si d))) (if (and o (not (vlax-erased-p o))) (entdel o) ) ) (if (and pl2 (not (vlax-erased-p pl2))) (entdel pl2) ) (if (and lwi (not (vlax-erased-p lwi))) (entdel lwi) ) ) ) (vl-cmdf "_.ZOOM" "_P") (setq lll (vl-remove-if-not (function (lambda ( x ) (vl-position (cdr (assoc 100 (reverse (entget x)))) (list "AcDb3PointAngularDimension" "AcDbArcDimension" "AcDbAlignedDimension")))) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sdim))))) (gc:UcsBoundingBox (car lll) (quote llp) (quote urp)) (vl-cmdf "_.MOVE" sdim "" "_non" (list 0.0 0.0 (caddr llp)) "_non" (list 0.0 0.0 0.0)) (foreach dim (vl-remove-if-not (function (lambda ( x ) (= (cdr (assoc 100 (reverse (entget x)))) "AcDbRadialDimension"))) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sdim)))) (gc:UcsBoundingBox dim (quote llp) (quote urp)) (vl-cmdf "_.MOVE" dim "" "_non" (list 0.0 0.0 (caddr llp)) "_non" (list 0.0 0.0 0.0)) ) (vl-cmdf "_.MOVE" sel "" "_non" (list 0.0 0.0 (caddr (trans (vlax-curve-getstartpoint (ssname sel 0)) 0 1))) "_non" (list 0.0 0.0 0.0)) ) ) (*error* nil) ) (defun c:autodim-dimtozero ( / es p ) (if (and (setq es (entsel "\nPick dimension to move it to 0.0 elevation...")) (= (cdr (assoc 0 (entget (car es)))) "DIMENSION")) (progn (setq p (osnap (cadr es) "_nea")) (if (not (equal (caddr p) 0.0 1e-6)) (vl-cmdf "_.MOVE" (car es) "" "_non" (list 0.0 0.0 (caddr p)) "_non" (list 0.0 0.0 0.0)) ) ) ) (princ) )