Page 1 of 2 12 LastLast
Results 1 to 10 of 16

Thread: Automatically dimension all sides and angles of selected polylines/polygons

  1. #1
    I could stop if I wanted to
    Join Date
    2011-09
    Posts
    308
    Login to Give a bone
    0

    Default Automatically dimension all sides and angles of selected polylines/polygons

    Hi folks,

    My clients dimension a lot of custom stone pavers (I mean A LOT!!!)

    I'd love to find a Lisp routine that lets them select multiple polygons and add dimensions for each side and all angles... thusly:



    Lots of routines come close but either select one object at a time or don't do the angles, etc.

    Any ideas?

    Thanks as always.
    Attached Images Attached Images

  2. #2
    I could stop if I wanted to
    Join Date
    2002-08
    Posts
    231
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    Hi,

    Try this! Adjust variable in lisp if it is not correct.

    Code:
    (defun c:DimPline ( / adoc space obj_dim obj_angdim height_dim pl ent obj dxf_ent ll ur dir_pt base_pt dir_ang last_pt pr_pt lst_pt nw_obj)
    	(vl-load-com)
    	(setq
    		adoc (vla-get-activedocument (vlax-get-acad-object))
    		space
    		(if (= 1 (getvar "CVPORT"))
    			(vla-get-paperspace adoc)
    			(vla-get-modelspace adoc)
    		)
    		obj_dim (vla-add (vla-get-Dimstyles adoc) "DIMPLINE")
    		obj_angdim (vla-add (vla-get-Dimstyles adoc) "DIMANGPLINE")
    	)
    	(vla-put-activedimstyle adoc obj_dim)
    	(initget 6)
    	(setq height_dim (getdist (getvar "VIEWCTR") (strcat "\nHeight of dim text <" (rtos (getvar "DIMTXT")) ">: ")))
    	(if height_dim (vla-setvariable adoc "DIMTXT" height_dim) (setq height_dim (getvar "DIMTXT")))
    	(mapcar '(lambda (data_list / ) (vla-setvariable adoc (car data_list) (cdr data_list)))
    		(list
    			(cons "DIMPOST" "")
    			(cons "DIMAPOST" "")
    			(cons "DIMSCALE" 1.0)
    			(cons "DIMASZ" (getvar "DIMTXT"))
    			(cons "DIMEXO" (/ (getvar "DIMTXT") 2.54))
    			(cons "DIMDLI" 0.38)
    			(cons "DIMEXE" (/ (getvar "DIMTXT") 2.54))
    			(cons "DIMRND" 0.0)
    			(cons "DIMDLE" (/ (getvar "DIMTXT") 2.54))
    			(cons "DIMTP" 0.0)
    			(cons "DIMTM" 0.0)
    			(cons "DIMCEN" 0.09)
    			(cons "DIMTSZ" 0.0)
    			(cons "DIMALTF" 25.4)
    			(cons "DIMLFAC" 1.0)
    			(cons "DIMTVP" 0.0)
    			(cons "DIMTFAC" 1.0)
    			(cons "DIMGAP" 0.09)
    			(cons "DIMALTRND" 0.0)
    			(cons "DIMTOL" 0)
    			(cons "DIMLIM" 0)
    			(cons "DIMTIH" 0)
    			(cons "DIMTOH" 0)
    			(cons "DIMSE1" 0)
    			(cons "DIMSE2" 0)
    			(cons "DIMTAD" 1)
    			(cons "DIMZIN" 0)
    			(cons "DIMALT" 0)
    			(cons "DIMALTD" 2)
    			(cons "DIMTOFL" 1)
    			(cons "DIMSAH" 0)
    			(cons "DIMTIX" 0)
    			(cons "DIMSOXD" 0)
    			(cons "DIMCLRD" 3)
    			(cons "DIMCLRE" 1)
    			(cons "DIMCLRT" 3)
    			(cons "DIMADEC" 2)
    			(cons "DIMDEC" 4)
    			(cons "DIMTDEC" 4)
    			(cons "DIMALTU" 6)
    			(cons "DIMALTTD" 2)
    			(cons "DIMAUNIT" 0)
    			(cons "DIMFRAC" 2)
    			(cons "DIMLUNIT" 4)
    			(cons "DIMDSEP" ".")
    			(cons "DIMTMOVE" 0)
    			(cons "DIMJUST" 0)
    			(cons "DIMSD1" 0)
    			(cons "DIMSD2" 0)
    			(cons "DIMTOLJ" 1)
    			(cons "DIMTZIN" 0)
    			(cons "DIMALTZ" 0)
    			(cons "DIMALTTZ" 0)
    			(cons "DIMUPT" 0)
    			(cons "DIMATFIT" 3)
    			(cons "DIMBLK" "_ARCHTICK")
    		)
    	)
    	(vla-copyfrom obj_dim adoc)
    	(vla-setvariable adoc "DIMBLK" ".")
    	(vla-copyfrom obj_angdim adoc)
    	(princ "\nSelect polylines: ")
    	(while (null (setq pl (ssget '((0 . "LWPOLYLINE"))))))
    	(repeat (setq n (sslength pl))
    		(setq
    			ent (ssname pl (setq n (1- n)))
    			obj (vlax-ename->vla-object ent)
    			dxf_ent (entget ent)
    			lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
    		)
    		(vla-GetBoundingBox obj 'll 'ur)
    		(setq
    			ll (safearray-value ll)
    			ur (safearray-value ur)
    			dir_pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
    			base_pt (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt))
    			dir_ang
    			(if (< (- (angle base_pt (polar base_pt (+ (angle (car lst_pt) (cadr lst_pt)) (* 0.5 pi)) (getvar "DIMTXT"))) (angle base_pt dir_pt)) pi)
    				(* pi 0.5)
    				(* pi 1.5)
    			)
    		)
    		(if (not (zerop (logand 1 (cdr (assoc 70 dxf_ent)))))
    			(setq last_pt (car lst_pt) lst_pt (cons (last lst_pt) lst_pt) pr_pt (last lst_pt))
    			(setq pr_pt nil)
    		)
    		(while (cdr lst_pt)
    			(vla-put-activedimstyle adoc obj_dim)
    			(setq nw_obj
    				(vla-addDimAligned
    					space
    					(vlax-3d-point (car lst_pt))
    					(vlax-3d-point (cadr lst_pt))
    					(vlax-3d-point (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt)))
    				)
    			)
    			(vlax-put nw_obj 'TextPosition (polar (vlax-get nw_obj 'TextPosition) (+ (angle (car lst_pt) (cadr lst_pt)) (+ dir_ang pi))(* 3.25 (getvar "DIMTXT"))))
    			(if pr_pt
    				(progn
    					(vla-put-activedimstyle adoc obj_angdim)
    					(setq nw_obj
    						(vla-AddDimAngular
    							space
    							(vlax-3d-point (car lst_pt))
    							(vlax-3d-point (cadr lst_pt))
    							(vlax-3d-point pr_pt)
    							(vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 5.0 (getvar "DIMTXT"))))
    						)
    						pr_pt (car lst_pt)
    					)
    				)
    				(setq pr_pt (car lst_pt))
    			)
    			(setq lst_pt (cdr lst_pt))
    		)
    		(if pr_pt
    			(setq nw_obj
    				(vla-AddDimAngular
    					space
    					(vlax-3d-point (car lst_pt))
    					(vlax-3d-point pr_pt)
    					(vlax-3d-point last_pt)
    					(vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 3.25 (getvar "DIMTXT"))))
    				)
    				pr_pt (car lst_pt)
    			)
    		)
    	)
    	(princ)
    )

  3. #3
    I could stop if I wanted to
    Join Date
    2011-09
    Posts
    308
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    Thanks Bruno!

    I'll test this tomorrow.

    On first flush it looks like it's creating all the dimension variables on the fly, would it be easier to have it simply use the current Dimstyle?

    I'll let you know how it goes tomorrow!

    -JP

  4. #4
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    Here is my version, short, but it satisfies my needs... Units are decimal, angles degrees/minutes and position of text is centered and aligned with dimension line... If you want above, just change (setvar 'dimtad 0) to (setvar 'dimtad 1)... Also, as I used (command) function I needed to create 2 separate Layers, so that picking of points won't interfere with previously dimension dimensions... Also if you are using A2015-16-17, it may fail because (command) calls are used in (mapcar '(lambda ( x ) (command ...))) loops... So advice for that is that you try to change (command) to (command-s)...

    Code:
    (defun c:dimpolygons ( / *error* mr_IsPointInside mid adoc sel lay d ts i lw enx pl lwn enxn plni plno plnom plm )
    
      (vl-load-com)
    
      (defun *error* ( m )
        (if lay
          (setvar 'clayer lay)
        )
        (vla-endundomark adoc)
        (if m
          (prompt m)
        )
        (princ)
      )
    
      (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))))
      (prompt "\nSelect closed POLYGONS...")
      (setq sel (ssget (list '(0 . "LWPOLYLINE") '(-4 . "&=") '(70 . 1) '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
      (setq lay (getvar 'clayer))
      (initget 7)
      (setq d (getdist "\nPick or specify offset distance for dimensioning : "))
      (setq ts (/ d 2.0))
      (setvar 'dimtxsty "Standard")
      (setvar 'dimjust 0)
      (setvar 'dimtad 0)
      (setvar 'dimtih 0)
      (setvar 'dimupt 0)
      (setvar 'dimtix 1)
      (setvar 'dimtofl 1)
      (setvar 'dimaunit 1)
      (setvar 'dimlunit 2)
      (setvar 'dimadec 1)
      (setvar 'dimdec 2)
      (setvar 'dimasz (/ ts 2.0))
      (vla-put-height (vlax-ename->vla-object (tblobjname "STYLE" "Standard")) ts)
      (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))))))
            (if (not (tblsearch "LAYER" "DIMALIGNED"))
              (command "_.-LAYER" "_M" "DIMALIGNED" "")
              (progn
                (command "_.-LAYER" "_T" "DIMALIGNED" "")
                (setvar 'clayer "DIMALIGNED")
              )
            )
            (mapcar (function (lambda ( a b c ) (command "_.DIMALIGNED" "_non" a "_non" b "_non" c))) pl (cdr (reverse (cons (car pl) (reverse pl)))) plnom)
            (if (not (tblsearch "LAYER" "DIMANGULAR"))
              (command "_.-LAYER" "_M" "DIMANGULAR" "")
              (setvar 'clayer "DIMANGULAR")
            )
            (command "_.-LAYER" "_F" "DIMALIGNED" "")
            (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 ) (command "_.DIMANGULAR" "" "_non" a "_non" b "_non" c "_non" d))) (cdr pl) plm (cdr (reverse (cons (car plm) (reverse plm)))) (cdr (reverse (cons (car plni) (reverse plni)))))
          )
          (command "_.-LAYER" "_T" "DIMALIGNED" "")
        )
        (prompt "\nEmpty sel. set... Retry routine with valid sel. set...")
      )
      (*error* nil)
    )
    HTH., M.R.

  5. #5
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    Here is better version, without Layer manipulations - it's based on Bruno's code using (vla-add...) functions... It's supposed to be equal to my previous code in terms of return dimensions... They should now be placed on current Layer and only new thing is that new dimension style is created...

    Code:
    (defun c:dimpolygons ( / *error* mr_IsPointInside mid adoc spc dim sel d ts i lw enx pl lwn enxn plni plno plnom plm )
    
      (vl-load-com)
    
      (defun *error* ( m )
        (vla-endundomark adoc)
        (if m
          (prompt m)
        )
        (princ)
      )
    
      (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" "DIMPOLYGON"))
        (setq dim (vla-add (vla-get-dimstyles adoc) "DIMPOLYGON"))
        (setq dim (vla-item (vla-get-dimstyles adoc) "DIMPOLYGON"))
      )
      (vla-put-activedimstyle adoc dim)
      (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 : "))
      (setq ts (/ d 2.0))
      (setvar 'dimtxsty "Standard")
      (setvar 'dimjust 0)
      (setvar 'dimtad 0)
      (setvar 'dimtih 0)
      (setvar 'dimupt 0)
      (setvar 'dimtix 1)
      (setvar 'dimtofl 1)
      (setvar 'dimaunit 1)
      (setvar 'dimlunit 2)
      (setvar 'dimadec 1)
      (setvar 'dimdec 2)
      (setvar 'dimasz (/ ts 2.0))
      (vla-put-height (vlax-ename->vla-object (tblobjname "STYLE" "Standard")) ts)
      (vla-copyfrom dim adoc)
      (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...")
      )
      (*error* nil)
    )
    Regards, M.R.
    Last edited by marko_ribar; 2017-02-18 at 04:38 PM.

  6. #6
    I could stop if I wanted to
    Join Date
    2011-09
    Posts
    308
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    Marko, this is working great so far! Thanks.

    I removed the bit that creates the dimstyle on the fly and replaced with a bit of code to check for and use our standard style (in red).

    Code:
    (defun c:dimpolygons ( / *error* mr_IsPointInside mid adoc spc sel d i lw enx pl lwn enxn plni plno plnom plm )
    
      (vl-load-com)
    
      (defun *error* ( m )
        (vla-endundomark adoc)
        (if m
          (prompt m)
        )
        (princ)
      )
    
      (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" "SCAPE Standard"))
        (Alert "SCAPE Standard dimension style not loaded")
        (Command "-dimstyle" "r" "SCAPE Standard")
      )
      (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...")
      )
      (*error* nil)
    )

    The only issue is that our standard style has an override for angular dimensions so they use arrows instead of ticks. When the command runs, it uses ticks everywhere. (see attached picks).

    Thanks for all your help!! Much appreciated.

    Screen Shot 2017-02-23 at 4.23.12 PM.png

    Screen Shot 2017-02-23 at 4.23.32 PM.png

  7. #7
    I could stop if I wanted to
    Join Date
    2015-10
    Location
    Central New Jersey
    Posts
    439
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    I believe you can add more to a dimstyle to have different settings when used for an angular dimension. Its almost like a sub-style of the current style.

  8. #8
    I could stop if I wanted to
    Join Date
    2011-09
    Posts
    308
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    Quote Originally Posted by MMccall View Post
    I believe you can add more to a dimstyle to have different settings when used for an angular dimension. Its almost like a sub-style of the current style.
    Thanks MMccall, we've got that set up in the dimstyle already. That's my issue. It's making the angular dims with ticks instead of arrows which is what out angular override is set to.

  9. #9
    I could stop if I wanted to
    Join Date
    2011-09
    Posts
    308
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    OK, I dug in a bit further.

    When I use this command (as I modified it) it makes all the dimensions in our standard Dimstyle (aligned and angular)

    However, the Angular Dims have their arrows overridden to ticks somehow (unsure where in the code this is happening).

    They also have the dimension text INSIDE the arc, not outside where they would be if I dimensioned the angles manually using our standard style.

    I can fix this by using the -dymstyle command to "Apply" the current dimestyle to the dimensions. But still unsure why I get ticks on the angular dims to begin with.

    Result of issuing the command:

    Screen Shot 2017-03-02 at 4.05.49 PM.png

    Result after issuing: -dimstyle -> Apply -> All:

    Screen Shot 2017-03-02 at 4.06.11 PM.png

    Here's the code (and the dimesnion creation bit n red). Any help is appreciated. As always.


    Code:
    (defun c:dimpolygons ( / *error* mr_IsPointInside mid adoc spc sel d i lw enx pl lwn enxn plni plno plnom plm clr)
    
      (vl-load-com)
    
      (defun *error* ( m )
        (vla-endundomark adoc)
        (if m
          (prompt m)
        )
        (princ)
      )
    
    (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" "SCAPE Standard"))
        (Alert "SCAPE Standard dimension style not loaded")
        (Command "-dimstyle" "r" "SCAPE Standard")
      )
      (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...")
      )
      (*error* nil)
    (setvar "CLAYER" clr)
    )

  10. #10
    I could stop if I wanted to
    Join Date
    2011-09
    Posts
    308
    Login to Give a bone
    0

    Default Re: Automatically dimension all sides and angles of selected polylines/polygons

    OK, well... I'm stumped. I just don't know enough about creating dimensions using DFX codes.

    I tried (unsucessfully) to add the line:

    Code:
    (setvar "DIMBLK" ".")
    to the routine before it creates the angled dims. No matter where I add it, it wrecks the code (and there's a more elegant way to do it I'm sure).

    I'd appreciate any help anyone can offer.

    Goals:

    • Get the angled dimension to have arrows instead of ticks
    • If possible get the text of the angled dimension above the dim line always


    Here again for reference is the code in it's current form:

    Code:
    (defun c:dimpolygons ( / *error* mr_IsPointInside mid adoc spc sel d i lw enx pl lwn enxn plni plno plnom plm clr)
    
      (vl-load-com)
    
      (defun *error* ( m )
        (vla-endundomark adoc)
        (if m
          (prompt m)
        )
        (princ)
      )
    
    (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" "SCAPE Standard"))
        (Alert "SCAPE Standard dimension style not loaded")
        (Command "-dimstyle" "r" "SCAPE Standard")
      )
      (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...")
      )
      (*error* nil)
    (setvar "CLAYER" clr)
    )

Page 1 of 2 12 LastLast

Similar Threads

  1. Replies: 0
    Last Post: 2016-11-21, 05:02 AM
  2. add areas of multiple selected polygons
    By Darren Allen in forum AutoLISP
    Replies: 3
    Last Post: 2014-09-26, 03:48 PM
  3. Convert Polylines to AEC Polygons
    By medwards.119413 in forum ACA Wish List
    Replies: 2
    Last Post: 2008-12-14, 11:48 PM
  4. Getting polylines or polygons out of mulitple arcs
    By Ernie.Salazar in forum AutoCAD Map 3D - General
    Replies: 3
    Last Post: 2004-08-13, 04:05 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •