Automatic distance between polygon vertices

[Basomis]

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

Edited October 24, 2014 by Basomis

[MSasu]

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.

[Basomis]

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.

[hanhphuc]

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

[Basomis]

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?

[hanhphuc]

hi Basomis,

try remove this line

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

[Basomis]

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?

[hanhphuc]

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

[marko_ribar]

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.

[Basomis]

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

[marko_ribar]

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

[hanhphuc]

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

[hanhphuc]

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