Automatic distance between polygon vertices

I need some LISP routine which autonumbers distance between polygon vertices.

I will use for that the built-in QDIM command with an appropriate dimension style (that it, hide the arrows, extension and dimension lines); don't forget to set an adequate UCS first. After call QSELECT with a filter for dimensions with Measuring feature smaller than given value and remove them. This will also ensure that the result is associative.

For some weird reason QDIM seems not to work on AutoCad Map. It's a pity that the suggestion posted above doesn't solve the problem. This LISP routine would greatly help since it takes ages to place those distances between every vertex.

i'm not sure is it similar previous thread?

The distance text is associative due to its actually a dimension without arrow looks like normal line object (similar mircea's idea)

if just a distance?

(defun c:test (/ p l e d var )
 (setq	l   '("CMDECHO" "OSMODE" "DIMTIH" "DIMTOH" "DIMASSOC")
var (mapcar 'getvar l)
) ;_ end of setq
 (mapcar 'setvar l '(0 0 0 0 2))
 (if (setq e (car (entsel "\nPick polygon.. "))) ;[color="red"]<---LWPOLYLINE[/color]
   (setq p (mapcar 'cdr (vl-remove-if-not ''((x) (= (car x) 10)) (entget e)))
  p (if	(= (cdr (assoc 70 (entget e))) 1)
      (append p (list (car p) (cadr p)))
      p
      ) ; if
  d (mapcar ''((a b) ([color="blue"]ppdim[/color] a b)) p (cdr p))
  ) ;_ end of setq
   (princ "\nInvalid. ")
   ) ;_ end of if
 (mapcar 'setvar l var)
 (princ)
 ) ;_ end of defun


;little tweak from previous [color="red"]ldim[/color] function
;http://www.cadtutor.net/forum/showthread.php?89187-Not-Aligned-Not-Linear-Lengths-but-geometric-or-List-Length

(defun [color="blue"]ppdim[/color] ( p1 p2 / mp sz )
;hanhphuc 24/10/2014
 (setq sz (* 0.05 (distance p1 p2)) mp (mapcar '(lambda (a b) (* 0.5 (+ a b))) p1 p2))
 (vl-cmdf "_dimaligned" p1 p2 mp)
 ('((obj)
    (mapcar
     '(lambda (a b) (vlax-put obj a b))
     '("Arrowhead1Type"	 "Arrowhead2Type"	  "extensionlineextend"	   "extensionlineoffset"
"TextHeight"		 "TextInside"		  "VerticalTextPosition"   "TextGap" 
)
     (list 19 19 0. 0. sz 1 1 sz)
     )
    (vlax-put-property obj 'TextFill :vlax-true)
    )
   (vlax-ename->vla-object (entlast))
   )
 ) ;_ end of defun

The final result should look like this:

The code posted above gives this result:

Could anyone edit that routine so the final result looks like the one I need?

hi Basomis,

try remove this line

..
(vlax-put-property obj 'TextFill :vlax-true)
..

Awesome, it removed textfill. But I also want to remove the dimension line below the number. The numbers should round to 2 decimal places and every number should appear outside the polygon. Is it possible to implement these requirements?

The numbers should round to 2 decimal places

(defun c:test (/ p l e d var )
 (setq	l   '("CMDECHO" "OSMODE" "DIMTIH" "DIMTOH" "DIMASSOC" [color="red"]"DIMDEC"[/color])
var (mapcar 'getvar l)
) ;_ end of setq
 (mapcar 'setvar l '(0 0 0 0 2 [color="red"]2[/color]))
...
...

The object actually is a dimension it uses current dimstyle,

but if you wanna remove it, i think need to explode but it will become non associative.

if just simple for placing text on polygon, either re-write new code or you can just search the web

Add this into (ppdim) subfunction

     '("Arrowhead1Type"     "Arrowhead2Type"      "extensionlineextend"       "extensionlineoffset"
       "TextHeight"         "TextInside"          "VerticalTextPosition"      "TextGap" 
       [color=red]"DimLine1Suppress"   "DimLine2Suppress"[/color]
       )
     (list 19 19 0. 0. sz 1 1 sz [color=red]1 1[/color])

HTH, M.R.

Great, the line below numbers don't appear anymore. The only thing left is how to make all numbers appear outside of the polygon?

Among my lisps like autoaldim.lsp, I've found somewhere on www, pdim.lsp that has this option (Inside/Outside)... Now you'll have to combine what's already explained and this pdim.lsp...

(defun c:pdim ( / ListClockwise-p ch plSet pLlst vLst oldOsn cAng cDis cPt )

 (defun ListClockwise-p ( lst / z vlst )
   (vl-catch-all-apply 'minusp 
     (list
       (if 
         (not 
           (equal 0.0
             (setq z
               (apply '+
                 (mapcar 
                   (function
                     (lambda (u v)
                       (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
                     )
                   )
                   (setq vlst
                     (mapcar
                       (function
                         (lambda (a b) (mapcar '- b a))
                       )
                       (mapcar (function (lambda (x) (car lst))) lst) 
                       (cdr (reverse (cons (car lst) (reverse lst))))
                     )
                   )
                   (cdr (reverse (cons (car vlst) (reverse vlst))))
                 )
               )
             ) 1e-6
           )
         )
         z
         (progn
           (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
           nil
         )
       )
     )
   )
 )

 (initget 1 "Outside Inside")
 (setq ch (getkword "\nChoose on which side to put dimensions [Outside/Inside] : "))
 (princ "\n<<< Select LwPolyline(s) for dimensioning >>> ")
 (if (setq plSet (ssget '((0 . "LWPOLYLINE"))))
   (progn
     (setq pLlst (vl-remove-if 'listp
                        (mapcar 'cadr(ssnamex plSet)))
           oldOsn (getvar "OSMODE")
     ); end setq
     (setvar "OSMODE" 0) (setvar "CMDECHO" 0)
     (command "_.undo" "_be")
     (foreach pl pLlst
      (setq vLst (mapcar '(lambda( x ) (trans x 0 1)) 
                   (mapcar 'cdr (vl-remove-if-not '(lambda( x ) (= 10 (car x)))
                                  (entget pl)
                                )
                   )
                 )
      ); end setq
      (if (equal (logand (cdr (assoc 70 (entget pl))) 1) 1)
       (setq vLst (append vLst (list (car vLst))))
      ); end if
      (if (not (ListClockwise-p vLst)) (setq vLst (reverse vLst)))
      (while (< 1 (length vLst))
       (setq cAng (angle (car vLst) (cadr vLst))
               cDis (/ (distance (car vLst) (cadr vLst)) 2.0)
       )
;        (if (>= (caar vLst) (caadr vLst))
;         (setq cAng (- cAng pi))
;        ); end if
       (if (eq ch "Inside")
        (setq cPt (polar (polar (car vLst) cAng cDis) (- cAng (* 0.5 pi)) (* 2.5 (getvar "DIMTXT")))); end setq
        (setq cPt (polar (polar (car vLst) cAng cDis) (+ cAng (* 0.5 pi)) (* 2.5 (getvar "DIMTXT")))); end setq
       ); end if
       (command "_.dimaligned" (car vLst) (cadr vLst) cPt)
       (setq vLst (cdr vLst))
      ); end while
     ); end foreach
     (command "_.undo" "_e")
     (setvar "OSMODE" oldOsn) (setvar "CMDECHO" 1)
   ); end progn
 ); end if
 (princ)
); end of c:pdim

HTH

Add this into (ppdim) subfunction

 

     '("Arrowhead1Type"     "Arrowhead2Type"      "extensionlineextend"       "extensionlineoffset"
       "TextHeight"         "TextInside"          "VerticalTextPosition"      "TextGap" 
       [color=red]"DimLine1Suppress"   "DimLine2Suppress"[/color]
       )
     (list 19 19 0. 0. sz 1 1 sz [color=red]1 1[/color])

HTH, M.R.

c:pdim 

HTH, M.R.

your pdim works fine ,but if the OP doesn't want the dimension line.

my 2 cents: make unique "pdim" layer.

After c:pdim done -> exploded "pdim" -> ssget all exploded lines -> (command "_erase" ss)

*It's OP's choice which associative or not

Updated as OP request, put text outside polygon

added 2 arguments

cw : T / nil ; cw/ccw

box : T / nil ; if T, Label with box

;ppdim.lsp , assosiative distance label (customized dimAligned)
http://www.cadtutor.net/forum/showthread.php?89363-Automatic-distance-between-polygon-vertices&p=612627#post612627

(defun ppdim ( p1 p2 [color="red"]cw box[/color] / mp sz mx ); [color="red"]v1.1[/color]
;hanhphuc 31/10/2014
 
 (setq vs '(nil (/ (getvar 'viewsize) (cadr (getvar 'screensize))))
sz (* 0.05 (distance p1 p2)) mp (mapcar '(lambda (a b) (* 0.5 (+ a b))) p1 p2)
)

 (vl-cmdf "_dimaligned" p1 p2 mp)
 ('((obj)
    (mapcar
     '(lambda (a b) (vlax-put obj a b))
     '("Arrowhead1Type"	 "Arrowhead2Type"	  "extensionlineextend"	   "extensionlineoffset"
"TextHeight"		 "TextInside"		  "VerticalTextPosition"   "TextGap"
 [color="red"]"DimLine1Suppress"   "DimLine2Suppress"[/color] ;<---[color="blue"] "line" visibility, thanks marko [/color]:-) 
)
     (list 19 19 0. 0. sz 1 (if cw 1 2) ((if box - +) sz) 1 1 );((if cw + -) sz)
     )
    (vlax-put-property obj 'TextFill [color="red"]:vlax-true[/color])  ;<--[color="blue"] text masked: [/color] [color="red"]1[/color] [color="blue"]or[/color] [color="red"]0[/color]
    )
   (vlax-ename->vla-object (entlast))
   )
 ) ;_ end of defun

(defun c:test (/ p l e d var) ;v1.1
 (setq	l   '("CMDECHO" "OSMODE" "DIMTIH" "DIMTOH" "DIMASSOC" "DIMDEC")
var (mapcar 'getvar l)
) ;_ end of setq
 (mapcar 'setvar l '(0 0 0 0 2 2))
 (if (setq e (car (entsel "\nPick polygon.. "))) ;<---LWPOLYLINE
   (setq p  (mapcar 'cdr (vl-remove-if-not ''((x) (= (car x) 10)) (entget e)))
  p  (if (= (cdr (assoc 70 (entget e))) 1)
       (append p (list (car p) (cadr p)))
       p
       ) ; if
  cw (LM:ListClockwise-p p)
  d  (mapcar ''((a b)
		(ppdim a b
		 (cond
		  ((and (minusp (cos (angle a b))) (not cw)) t)
		  ((and (minusp (cos (angle a b))) cw ) nil)
		  (t cw)
		  ) ;_ end of cond
		[color="red"][b] t [/b][/color]	;<------- [color="blue"][color="red"]t [/color]= boxed / [color="red"]nil [/color]= normal[/color] , [color="blue"]here to change boxed setting ![/color]
		 )
		)
	     p
	     (cdr p)
	     ) ;_ end of mapcar
  ) ;_ end of setq
   (princ "\nInvalid. ")
   ) ;_ end of if
 (mapcar 'setvar l var)
 (princ)
 ) ;_ end of defun


;; coutesy & reference
;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented
http://www.lee-mac.com/mathematicalfunctions.html

(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)
           )
       )
   )
)

It still has minor bug can't fix, beyond my capability