OK, well I went back to an old routine I had and now its working... better. Still inelegant if you ask me as I still have to modify the dimensions after they are created. But at least it's only dealing with the dimensions that were created during the execution of the routine and not all dimensions in the drawing.
I'd still rather the angular dimensions were created with arrows to begin with as defined in our standard dimstyle.
Any help, as always, is appreciated.
New code in red:
Code:
(defun c:dimpolygons ( / *error* mr_IsPointInside mid adoc spc sel d i lw enx pl lwn enxn plni plno plnom plm clr lastent ss en)
(vl-load-com)
(defun *error* ( m )
(vla-endundomark adoc)
(if m
(prompt m)
)
(princ)
)
(setq lastEnt (entlast))
(setq clr (getvar "CLAYER"))
(command "-layer" "Make" "0-Dims" "color" "3" "" "")
(defun mr_IsPointInside ( pt ptlst / trianglst ptinsidetriangle-p trl )
(defun trianglst ( ptlst / unique LM:ListClockwise-p clockwise-p l p1 p2 p3 trl )
(defun unique ( l )
(if l (cons (car l) (unique (vl-remove-if (function (lambda ( x ) (equal x (car l) 1e-6))) l))))
)
;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented
(defun LM:ListClockwise-p ( lst )
(minusp
(apply '+
(mapcar
(function
(lambda ( a b )
(- (* (car b) (cadr a)) (* (car a) (cadr b)))
)
)
lst (cons (last lst) lst)
)
)
)
)
(defun clockwise-p ( p1 p2 p3 )
(< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
)
)
(setq l ptlst)
(while (> (length ptlst) 3)
(setq p1 (car ptlst) p2 (cadr ptlst) p3 (caddr ptlst))
(cond
( (LM:ListClockwise-p ptlst)
(if
(and
(clockwise-p p1 p2 p3)
(= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p1 p2 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
(= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p2 p3 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
(= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p3 p1 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
)
(progn
(setq trl (cons (list p1 p2 p3) trl))
(setq ptlst (vl-remove p2 ptlst))
(setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
)
(setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
)
)
( (not (LM:ListClockwise-p ptlst))
(if
(and
(not (clockwise-p p1 p2 p3))
(= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p1 p2 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
(= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p2 p3 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
(= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p3 p1 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
)
(progn
(setq trl (cons (list p1 p2 p3) trl))
(setq ptlst (vl-remove p2 ptlst))
(setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
)
(setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
)
)
)
)
(setq trl (cons (list (car ptlst) (cadr ptlst) (caddr ptlst)) trl))
trl
)
(defun ptinsidetriangle-p ( pt p1 p2 p3 )
(and
(not
(or
(inters pt p1 p2 p3)
(inters pt p2 p1 p3)
(inters pt p3 p1 p2)
)
)
(not
(or
(> (+ (distance pt p1) (distance pt p2)) (+ (distance p3 p1) (distance p3 p2)))
(> (+ (distance pt p2) (distance pt p3)) (+ (distance p1 p2) (distance p1 p3)))
(> (+ (distance pt p3) (distance pt p1)) (+ (distance p2 p3) (distance p2 p1)))
)
)
)
)
(setq trl (trianglst ptlst))
(vl-some (function (lambda ( x ) (ptinsidetriangle-p pt (car x) (cadr x) (caddr x)))) trl)
)
(defun mid ( p1 p2 )
(mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
)
(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(setq spc (vla-get-block (vla-get-activelayout adoc)))
(if (not (tblsearch "DIMSTYLE" "MVVA Standard Imperial"))
(Alert "MVVA Standard Imperial dimension style not loaded")
(Command "-dimstyle" "r" "MVVA Standard Imperial")
)
(prompt "\nSelect closed POLYGONS...")
(setq sel (ssget (list '(0 . "LWPOLYLINE") '(-4 . "&=") '(70 . 1) '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
(initget 7)
(setq d (getdist "\nPick or specify offset distance for dimensioning : "))
(if sel
(progn
(repeat (setq i (sslength sel))
(setq lw (ssname sel (setq i (1- i))))
(setq enx (entget lw))
(setq pl (mapcar (function (lambda ( x ) (trans (list (car x) (cadr x) (cdr (assoc 38 enx))) lw 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) enx))))
(vla-offset (vlax-ename->vla-object lw) d)
(setq lwn (entlast))
(setq enxn (entget lwn))
(setq plni (mapcar (function (lambda ( x ) (trans (list (car x) (cadr x) (cdr (assoc 38 enxn))) lwn 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) enxn))))
(if (not (mr_IsPointInside (car plni) pl))
(progn
(entdel lwn)
(vla-offset (vlax-ename->vla-object lw) (- d))
(setq lwn (entlast))
(setq enxn (entget lwn))
(setq plni (mapcar (function (lambda ( x ) (trans (list (car x) (cadr x) (cdr (assoc 38 enxn))) lwn 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) enxn))))
)
)
(entdel lwn)
(setq plno (mapcar (function (lambda ( a b ) (mapcar (function +) a (mapcar (function -) a b)))) pl plni))
(setq plnom (mapcar (function (lambda ( a b ) (mid a b))) plno (cdr (reverse (cons (car plno) (reverse plno))))))
(mapcar (function (lambda ( a b c ) (vla-addDimAligned spc (vlax-3d-point a) (vlax-3d-point b) (vlax-3d-point c)))) pl (cdr (reverse (cons (car pl) (reverse pl)))) plnom)
(setq pl (reverse (cons (car pl) (reverse pl))))
(setq plm (mapcar (function (lambda ( a b ) (mid a b))) pl (cdr pl)))
(mapcar (function (lambda ( a b c d ) (vla-AddDim3PointAngular spc (vlax-3d-point a) (vlax-3d-point b) (vlax-3d-point c) (vlax-3d-point d)))) (cdr pl) plm (cdr (reverse (cons (car plm) (reverse plm))))
(cdr (reverse (cons (car plni) (reverse plni)))))
)
)
(prompt "\nEmpty sel. set... Retry routine with valid sel. set...")
)
(setq ss (ssadd))
(if (setq en (entnext LastEnt)) ;Check if there's a new entity created since the last one
(while en ;Step through all new entities
(ssadd en ss) ;Add it to the selection set
(setq en (entnext en)) ;Get the next entity
)
)
(command "_.-dimstyle" "Apply" ss "")
(*error* nil)
(setvar "CLAYER" clr)
)
Re: Automatically dimension all sides and angles of selected polylines/polygons
Reply With Quote
Originally Posted by marcosjocol
