Author Topic: Automatically dimension all sides and angles of a polygon  (Read 2382 times)

0 Members and 1 Guest are viewing this topic.

jpcadconsulting

  • Newt
  • Posts: 56
Automatically dimension all sides and angles of a polygon
« on: March 22, 2017, 02:15:46 PM »
Hi gang, long time no see.

With a lot of help (and I mean A LOT), I've been putting together this code that lets me select polygons and automatically dimension them.

It's working almost perfectly.

I select the polygon(s) and it creates the dimensions on the correct layer, in our standard style, but the angled dimensions have ticks instead of arrows (even though we have a specific sub style for angled dims that uses arrows) - see attachment.  I update all the dimensions (-dimstyle > apply > All) the angled dimensions are corrected - even thouigh they are already the correct style.

Also (and less important) I'd love for the text in the angled dimensions to be on the other side of the dimension line.


Code: [Select]
(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)
)

Thanks for any help, as always!!!
« Last Edit: March 22, 2017, 02:20:30 PM by jpcadconsulting »
Technology will save us all! *eyeroll*

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Automatically dimension all sides and angles of a polygon
« Reply #1 on: March 22, 2017, 02:28:19 PM »
You've forgot to mention that the code was writen by Marko Ribar.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

jpcadconsulting

  • Newt
  • Posts: 56
Re: Automatically dimension all sides and angles of a polygon
« Reply #2 on: March 22, 2017, 02:31:10 PM »
I did indeed.  I thought that was in the text at the top of the code...

Sorry.

Yes, all kudos to Mark Ribar for the original code and also to the mighty Lee Mac for some code in there dealing with some esoteric god only knows what regarding clockwise vs. counterclockwise.  ;-)
Technology will save us all! *eyeroll*

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jpcadconsulting

  • Newt
  • Posts: 56
Re: Automatically dimension all sides and angles of a polygon
« Reply #4 on: April 12, 2017, 02:54:12 PM »
Well, I beat my head against this for a lot more time and got nowhere.

I have added the following line of code to the end of the routine and it works, but it's really inelegant.

Code: [Select]
(command "_.-dimstyle" "A" "all" "")
So at the end it just selects all dimensions in the drawing and applys the current dimstyle to them. Very poor form, I realize.

What I'd really like to do is apply the current dimstyle to only the angular dims created during the current execution of the lisp routine.

What I'd really really like to do is get the routine to make the angular dims with arrowheads (the way they are defined in the standard dimstyle) to begin with.

As always, any help at all is greatly appreciated.

-JP
Technology will save us all! *eyeroll*

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Automatically dimension all sides and angles of a polygon
« Reply #5 on: April 12, 2017, 03:00:52 PM »
To collect all the new entities find this routine.
Code: [Select]
; Function: ALE_LastEnt - original by Rune Wold and Michael Puckett (lastent)
;
; Version 1.01 - 20/12/2004 - modified with (and ...)
;
; Description:
;   get the absolute last entity in the database,
;   for problems in >=r15 in blocks with attrib, and polylines
;
; Arguments: none
;
; Return Values:
;   An entity name;
;   otherwise nil, if there are no entities in the current drawing
;
; Example: (setq marker (ALE_LastEnt)) see ALE_Ss-After
;
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jpcadconsulting

  • Newt
  • Posts: 56
Re: Automatically dimension all sides and angles of a polygon
« Reply #6 on: April 12, 2017, 03:45:43 PM »
I went back to an older routine I had kicking around and now it's working... better.  Still inelegant in my opinion as it has to update the dimensions after they are created.  but at least now it's only dealing with the dimensions created during the run of the routine.

Added code in red.

Code: [Select]
(defun c:dimpolygons ( / *error* mr_IsPointInside mid adoc spc sel d i lw enx pl lwn enxn plni plno plnom plm clr [color=red]lastent ss en[/color])

  (vl-load-com)

  (defun *error* ( m )
    (vla-endundomark adoc)
    (if m
      (prompt m)
    )
    (princ)
  )
[color=red](setq lastEnt (entlast))[/color]
(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...")
  )

[color=red](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 "")[/color]
  (*error* nil)
  (setvar "CLAYER" clr)
)
Technology will save us all! *eyeroll*

David Bethel

  • Swamp Rat
  • Posts: 656
Re: Automatically dimension all sides and angles of a polygon
« Reply #7 on: April 13, 2017, 01:20:18 PM »
This is cobble together from some room dimension routines that I have.

It work on Heavy POLYLINES ONLY.

Code - Auto/Visual Lisp: [Select]
  1.  
  2.  
  3. (defun c:dcpline (/ tz ss i en ed vn vd vl cf v sp ep)
  4.  
  5. (defun dcp_ldim (sp ep tz / a p d s1 s2 s3 a1 e1 e2 e2 a2 e3 mp tp)
  6.   (setq a (angle sp ep)
  7.         p (- a (* pi 0.5))
  8.         d (distance sp ep)
  9.        s1 (polar sp p (* tz 1.0))
  10.        s2 (polar sp p (* tz 3.0))
  11.        s3 (polar sp p (* tz 4.0))
  12.        a1 (polar s2 a (* tz 0.75))
  13.        e1 (polar ep p (* tz 1.0))
  14.        e2 (polar ep p (* tz 3.0))
  15.        e3 (polar ep p (* tz 4.0))
  16.        a2 (polar e2 (+ a pi) (* tz 0.75))
  17.        mp (mapcar '(lambda (a b) (* (+ a b) 0.5)) s2 e2)
  18.        tp (polar mp p (* tz 1.5)))
  19.  
  20.   ;;;LINEAR
  21.   (entmake (list (cons 0 "LINE")(cons 62 1)(cons 10 s1)(cons 11 s3)))
  22.   (entmake (list (cons 0 "LINE")(cons 62 1)(cons 10 e1)(cons 11 e3)))
  23.   (entmake (list (cons 0 "LINE")(cons 62 2)(cons 10 s2)(cons 11 e2)))
  24.   (entmake (list (cons 0 "SOLID")(cons 62 2)
  25.                  (cons 10 s2)(cons 11 (polar a1 (+ p pi) (* tz 0.25)))
  26.                  (cons 12 (polar a1 p (* tz 0.25)))(cons 13 a1)))
  27.   (entmake (list (cons 0 "SOLID")(cons 62 2)
  28.                  (cons 10 e2)(cons 11 (polar a2 (+ p pi) (* tz 0.25)))
  29.                  (cons 12 (polar a2 p (* tz 0.25)))(cons 13 a2)))
  30.   (entmake (list (cons 0 "TEXT")(cons 1 (rtos d 2 2))
  31.                  (cons 7 (getvar "TEXTSTYLE"))
  32.                  (cons 10 tp)(cons 11 tp)
  33.                  (cons 39 1e-11)(cons 40 tz)
  34.                  (cons 50 (if (< (* pi 0.5) a (* pi 1.5)) (+ a pi) a))
  35.                  (cons 62 3)(cons 72 4))))
  36.  
  37.  
  38. ;;;Start_angle_Point Vertext_Point End_angle_Point TextsiZe
  39. (defun dcp_adim (sp vp ep tz / sa ea ia ta tp a s1 s2 a1 a2)
  40.   (setq sa (angle vp sp)
  41.         ea (angle vp ep)
  42.         ia (if (> sa ea)
  43.                (+ (- (* 2 pi) sa) ea)
  44.                   (- ea sa))
  45.  
  46.         tp (polar vp (+ sa (* ia 0.5)) (* tz 4.0))
  47.         a (+ sa (* ia 0.5) (* pi 0.5))
  48.         s1 (polar vp sa (* tz 3.0))
  49.         s2 (polar vp ea (* tz 3.0))
  50.         a1 (polar s1 (+ sa (* pi 0.5)) (* tz 0.75))
  51.         a2 (polar s2 (- ea (* pi 0.5)) (* tz 0.75))
  52.         ta (angle a1 a2))
  53.  
  54.   (entmake (list (cons 0 "LINE")(cons 62 1)
  55.                  (cons 10 (polar vp sa (* tz 1.0)))
  56.                  (cons 11 (polar vp sa (* tz 4.0)))))
  57.   (entmake (list (cons 0 "LINE")(cons 62 1)
  58.                  (cons 10 (polar vp ea (* tz 1.0)))
  59.                  (cons 11 (polar vp ea (* tz 4.0)))))
  60.  
  61.   (entmake (list (cons 0 "SOLID")(cons 62 2)
  62.                  (cons 10 s1)(cons 11 (polar a1 sa (* tz -0.25)))
  63.                  (cons 12 (polar a1 sa (* tz  0.25)))(cons 13 a1)))
  64.   (entmake (list (cons 0 "SOLID")(cons 62 2)
  65.                  (cons 10 s2)(cons 11 (polar a2 ea (* tz -0.25)))
  66.                  (cons 12 (polar a2 ea (* tz  0.25)))(cons 13 a2)))
  67.  
  68.   (entmake (list (cons 0 "ARC")(cons 62 2)
  69.                  (cons 10 vp)
  70.                  (cons 40 (* tz 3.0))
  71.                  (cons 50 sa)
  72.                  (cons 51 (+ sa ia))))
  73.  
  74.     (entmake (list (cons 0 "TEXT")(cons 1 (angtos ia 0 2))
  75.                    (cons 7 (getvar "TEXTSTYLE"))
  76.                    (cons 10 tp)(cons 11 tp)
  77.                    (cons 39 1e-11)(cons 40 tz)
  78.                    (cons 50 (if (< (* pi 0.5) ta (* pi 1.5)) (+ ta pi) ta))
  79.                    (cons 62 3)(cons 72 4))))
  80.  
  81. (defun surf (lst / sum i)
  82.    (setq i 0 sum 0)
  83.    (while (< i (- (length lst) 1))
  84.           (setq sum (+ sum (- (* (car (nth i lst))  (cadr (nth (+ 1 i) lst)))
  85.                               (* (cadr (nth i lst)) (car  (nth (+ 1 i) lst))))))
  86.       (setq i (1+ i)))
  87.    (/ sum 2.0))
  88.  
  89.  
  90.   (initget 6)
  91.   (setq tz (getdist (strcat "\nText Size <" (rtos (getvar "TEXTSIZE") 2 2) ">:   ")))
  92.   (or tz (setq tz (getvar "TEXTSIZE")))
  93.   (setvar "TEXTSIZE" tz)
  94.  
  95.   (and (princ "\nSelect Closed POLYLINEs")
  96.        (setq ss (ssget (list (cons 0 "POLYLINE")(cons -4 "<=")(cons 70 1))))
  97.        (setq i 0)
  98.        (while (setq en (ssname ss i))
  99.               (setq ed (entget en)
  100.                     vn (entnext en)
  101.                     vd (entget vn)
  102.                     cf (if (= (logand (cdr (assoc 70 ed)) 1) 1) T nil)
  103.                     vl nil)
  104.               (while (= "VERTEX" (cdr (assoc 0 vd)))
  105.                      (setq vl (cons (list (cadr (assoc 10 vd))
  106.                                           (caddr (assoc 10 vd))) vl)
  107.                            vn (entnext vn)
  108.                            vd (entget vn)))
  109.               (and cf
  110.                  (not (equal (car vl) (last vl) 1e-8))
  111.                  (setq vl (cons (last vl) vl)))
  112.               (if (minusp (surf vl))
  113.                   (setq vl (reverse vl)))
  114.               (setq v 0)
  115.               (repeat (1- (length vl))
  116.                   (setq sp (nth (+ v 0) vl)
  117.                         ep (nth (+ v 1) vl))
  118.                   (dcp_ldim sp ep tz)
  119.                   (dcp_adim (nth (+ v 1) vl)
  120.                            (nth (+ v 0) vl)
  121.                            (if (= v 0)
  122.                                (nth (- (length vl) 2) vl)
  123.                                (nth (- v 1) vl))
  124.                                tz)
  125.                   (setq v (1+ v)))
  126.               (setq i (1+ i))))
  127.  
  128.  
  129.  

I could be modified for other entities fairly easily

It doesn't make true DIMENSION entities.  In my experience, if the form is modified in any form, everything is erased and the entire routine is run again

-David
R12 Dos - A2K

jpcadconsulting

  • Newt
  • Posts: 56
Re: Automatically dimension all sides and angles of a polygon
« Reply #8 on: April 13, 2017, 01:39:37 PM »
Just to clarify,

I'm not calling Marko Ribars original code inelegant, it is in fact terrific.

It's my own ham-fisted additions to his code that I'm calling inelegant. :-)

Thanks again Marko!
Technology will save us all! *eyeroll*

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Automatically dimension all sides and angles of a polygon
« Reply #9 on: April 17, 2017, 10:57:21 AM »
To collect all the new entities find this routine.
Code: [Select]
; Function: ALE_LastEnt - original by Rune Wold and Michael Puckett (lastent)
;
; Version 1.01 - 20/12/2004 - modified with (and ...)
;
; Description:
;   get the absolute last entity in the database,
;   for problems in >=r15 in blocks with attrib, and polylines
;
; Arguments: none
;
; Return Values:
;   An entity name;
;   otherwise nil, if there are no entities in the current drawing
;
; Example: (setq marker (ALE_LastEnt)) see ALE_Ss-After
;
and use the last version:
Code: [Select]
; Marc'Antonio Alessi
; Function: ALE_Ss-After thanks to Michael Puckett (Ss-After)
;
; Version 1.01 - 20/12/2004 for empty DWG
; Version 1.02 - 30/09/2005
; Version 1.03 - 06/05/2010 to support Bricscad
;
; Description:
;   get a selection set of items after EntNam in the database
;
; Arguments: An entity name
;
; Return Values:
;   A selection set;
;   otherwise nil, if there are no entities after EntNam
;
; Examples:
;   (setq marker (ALE_LASTENT)) ...create new entities...
;   to include reference entity:
;   (command "_.MOVE" (ALE_SS-AFTER marker) marker "" ...)
;   Note: NOT valid if marker is a SEQEND of
;   blocks with attrib or old polylines (PLINETYPE = 0)
;
;   not include reference entity:
;   (command "_.MOVE" (ALE_SS-AFTER marker) "" ...)
;
(defun ALE_Ss-After (EntNam / SelSet)
  (cond
    ( (not EntNam) (ssget "_X" '((0 . "~VIEWPORT"))) ); "~VIEWPORT" x Bricscad
    ( (setq EntNam (entnext EntNam))
      (setq SelSet (ssadd EntNam))
      (while (setq EntNam (entnext EntNam))
        (if (entget EntNam) (ssadd EntNam SelSet))
      )
      SelSet
    )
  )
)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Automatically dimension all sides and angles of a polygon
« Reply #10 on: April 18, 2017, 08:39:09 AM »
Thanks for the update. :)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.