[B2Slow]

Нужно автоматически проставить размер линий или сегментов полилинии Aligned Dimension-ом с привязкой к центру сегмента, выделяя сразу несколько полилиний или линий.

[Лентяй]

Можно. Примерно так:

Код:

[Выделить все]

(defun C:PlMDim (/ par dim pts)
  (prompt "\nSelect Polylines: ") 
  (ssget) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        ass (vla-get-ActiveSelectionSet adoc)
        csp (vla-ObjectIDToObject adoc (vla-get-OwnerID (vla-item ass 0))))
  (vlax-for ent ass
    (if (= (vla-get-objectname ent) "AcDbPolyline")
      (progn (setq par (- (vlax-curve-getParamAtPoint ent (vlax-curve-getEndPoint ent)) 0.5))
        (while (> par 0.5)
          (setq pts (mapcar '(lambda (x) (vlax-3d-point (vlax-curve-getPointAtParam ent x)))
                    (list par (1- par) (fix par)))
              par (1- par));setq
        (if pts (progn (setq dim (vla-addDimAligned csp (car pts) (cadr pts) (last pts)))
                  (mapcar '(lambda (x y) (vlax-put-property dim x y))
              '(TextInsideAlign VerticalTextPosition) (list 0 acAbove)))));while
    ));if
  );vlax-for
);end

Размерный текст получаются выровненным над размерной линией. Только вот место размерного текста отлаживается вручную. потому как корявость полилинии - параметр неизвестный.

[B2Slow]

аааа.. Лентяй, я имел в виду привязку текста размера, а не привязку размерных точек.. выразился непонятно, к сожалению..
Нужно что-то типа

Код:

[Выделить все]

^C^C_dimaligned ;

, только сразу к нескольким объектам (линиям/полилиниям) в т.ч. сегментам полилинии.
А это будет работать в пользовательских ПСК?

[Лентяй]

Тогда непонятна сама проблема, потому как при построении любого размера, что прямого, что выраненного (aligned), техст автоматом встает посередине линий-выносок. Все остальное достигается соответсвующей настройкой стиля. Впрочем, попробуй такую прогу

Код:

[Выделить все]

(defun C:PlMDim (/ par dim pts)
  (prompt "\nSelect Polylines: ") 
  (ssget) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        ass (vla-get-ActiveSelectionSet adoc)
        csp (vla-ObjectIDToObject adoc (vla-get-OwnerID (vla-item ass 0))))
  (vlax-for ent ass
    (if (= (vla-get-objectname ent) "AcDbPolyline")
      (progn (setq par (vlax-curve-getParamAtPoint ent (vlax-curve-getEndPoint ent)))
        (while (> par 0)
          (setq pts (mapcar '(lambda (x) (vlax-3d-point (vlax-curve-getPointAtParam ent x)))
                    (list par (1- par) (fix par)))
              par (1- par));setq
        (if pts (progn (setq dim (vla-addDimAligned csp (car pts) (cadr pts) (last pts)))
                  (mapcar '(lambda (x y) (vlax-put-property dim x y))
              '(TextInsideAlign VerticalTextPosition) (list 0 acAbove)))));while
    ));if
  );vlax-for
);end

[B2Slow]

Вот-вот-вот, то что нужно!!.. Проблема была в том, чтобы поставить размер на все сегменты одновременно, а про привязку текста я для сведения сказал. Лентяй, ну пожалуйста, еще одно усилие.. А обычные line можно сюда же?..
Для вас профессионалов-магистров это просто разминка, а для обычных смертных это порядковое сокращение рутинной работы...:roll: Спасибо.

[Лентяй]

B2Slow: А обычные line можно сюда же?..

Послушайте, B2Slow, вам кто-нибудь говорил, что вы - зануда?

Для вас профессионалов-магистров это просто разминка, а для обычных смертных это порядковое сокращение рутинной работы...

И льстец? Ну да ладно. держите очередной апгрейд, ибо добр аз есмь днесь.

Код:

[Выделить все]

(defun C:PlMDim (/ par dim pts)
  (prompt "\nSelect Polylines: ") 
  (ssget) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        ass (vla-get-ActiveSelectionSet adoc)
        csp (vla-ObjectIDToObject adoc (vla-get-OwnerID (vla-item ass 0))))
  (vlax-for ent ass
    (cond ((= (vla-get-objectname ent) "AcDbPolyline")
           (setq par (vlax-curve-getParamAtPoint ent (vlax-curve-getEndPoint ent)))
           (while (> par 0)
             (setq pts (mapcar '(lambda (x) (vlax-3d-point (vlax-curve-getPointAtParam ent x)))
                          (list par (1- par) (- par 0.5)))
                   par (1- par));setq
             (if pts (progn (setq dim (vla-addDimAligned csp (car pts) (cadr pts) (last pts)))
                  (mapcar '(lambda (x y) (vlax-put-property dim x y))
              '(TextInsideAlign VerticalTextPosition) (list 0 acAbove))))));PLine
          ((= (vla-get-objectname ent) "AcDbLine")
           (setq pts (mapcar '(lambda (x) (vlax-get-property ent x))
                       '(StartPoint EndPoint))
                 dim (vla-addDimAligned csp (car pts) (cadr pts) (last pts)))
           (mapcar '(lambda (x y) (vlax-put-property dim x y))
              '(TextInsideAlign VerticalTextPosition) (list 0 acAbove)));Line
    );cond
  );vlax-for
);end

[B2Slow]

Сообщение от Лентяй B2Slow: А обычные line можно сюда же?.. Послушайте, B2Slow, вам кто-нибудь говорил, что вы - зануда? Для вас профессионалов-магистров это просто разминка, а для обычных смертных это порядковое сокращение рутинной работы... И льстец? Ну да ладно. держите очередной апгрейд, ибо добр аз есмь днесь.

Да не зануда мы и не льстец.. Мы это сразу в "техзадании" изложил))).. Я ж не могу доделать это сам..
И "профессионал" у вас под ником стоит, чему я не имею причин не верить..
Спасибо. Теперь мы можем быть счастлив..

[asys]

>Лентяй
Круто, я тоже заценил. А можно для меня чтоб с отступом от измеряемой линии на высоту тексата + 2 смещения текста от размерной линии. Мне на плане размеры помещений проставлять 8) Плиз-з-з

[Лентяй]

Как писала А. Ахматова, "В очередь. суки, в очередь!" Имейте совесть, у меня уже 2 часа ночи! Вот выйду с утреца на службу. там и накатаю.

[asys]

А у нас обед (13:02 по москве)

[fixo]

Сообщение от Asys А у нас обед (13:02 по москве)

;;;Еще одна программа тоже близко к данной теме:
;;;образмеривает замкнутые полилинии (вынос размерной линии
;;;нужно изменить в зависимости от единиц рисования)
;;;Без проверок на замкнутость и замороженный слой
;;;____________________
;;;А2005, Windows XP

Код:

[Выделить все]

;; Program draw a dimension of all polygon segments
;; Polygon must be closed
;; Copyrights (c) 2005 Fatty T.O.H.
;; All rights removed


;; helper function: written by Luis Esquivel 
;; get coordinates
;; ***  координаты полилинии  ***
(defun get_vertices (obj / i verts)
  (setq i (1- (vlax-curve-getendparam obj)))
  (while (>= i 0)
    (setq verts	(cons (vlax-curve-getpointatparam obj i) verts)
	  i	(1- i)
    )
  )
  verts
)

;; helper function: written by Fatty T.O.H.

;; ***  разность двух углов  ***
(defun dif-angle (ang1 ang2 / def)
  (set 'ang1
       (if (> ang2 (+ pi ang1))
	 (+ (* pi 2) ang1)
	 ang1
       )
  )
  (set 'ang2
       (if (> ang1 (+ pi ang2))
	 (+ (* pi 2) ang2)
	 ang2
       )
  )
  (setq def (- ang2 ang1))
)
;; helper function: written by Fatty T.O.H.

;; ***  проверка на направление полилинии  ***
;; возвращает Т если полилиния нарисована против
;; часовой стрелки (angdir=0)
(defun ccw-test	(pt_list / angle_list)
  (setq	angle_list
	 (mapcar (function (lambda (x y)
			     (angle x y)
			   )
		 )
		 pt_list
		 (cdr pt_list)
	 )
  )
  (if (> (apply	'+
		(mapcar	(function (lambda (x y) (dif-angle x y)))
			angle_list
			(cdr angle_list)
		)
	 )
	 0
      )
    t
    nil
  )
)
;; ***  основная программа  ***

(defun C:dmp (/ acsp adoc cent_coords coords pl txt_coords)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq acsp (vla-get-modelspace adoc))
  (setq	pl (vlax-ename->vla-object
	     (car (entsel "\nУказать замкнутую полилинию \n"))
	   )
  )
  (if (eq :vlax-false (vla-get-closed pl))
    (progn
      (alert "Контур незамкнут\n
      \t Выход")(exit)))
  (setq	coords (get_vertices pl)
	coords (append coords (list (car coords)))
  )
  (if (ccw-test coords)(setq dop pi)(setq dop 0)) 
  (setq	cent_coords
	 (mapcar (function (lambda (x y)
			     (mapcar '/ (mapcar '+ x y) '(2 2 2))
			   )
		 )
		 coords
		 (cdr coords)
	 )
  )
  (setq	txt_coords
	 (mapcar (function (lambda (x y z)
			     (polar x (+ dop (angle y z) (/ pi 2)) 8.);вынос размерной линии изменить
			   )
		 )
		 cent_coords
		 coords
		 (cdr coords)
	 )
  )
  (mapcar (function (lambda (x y z)
		      (vla-adddimaligned acsp x y z)
		    )
	  )
	  (mapcar 'vlax-3d-point coords)
	  (mapcar 'vlax-3d-point (cdr coords))
	  (mapcar 'vlax-3d-point txt_coords)
  )
  (princ)
)

(prompt "\n\t***\tОБРАЗМЕРИВАНИЕ ЗАМКНУТЫХ ПОЛИГОНОВ\t***\n")
(prompt "\nНабери в командной строке DMP для выполнения команды\n")

;TesT:
;(C:dmp)(princ)

[asys]

>Fatty
Спасибо, жаль что только для замкнутых контуров

[Лентяй]

Asys, держите вашу прогу. Пришлось изменить почти всю логику и провозиться пару часов. Пользуйтесь и не забывайте утренне и нощно сугубо и трегубо благодарить меня за то, что я есть.

Код:

[Выделить все]

(defun C:PlMDim (/ par dim pts dpt wpt tpt dpts) 
  (prompt "\nSelect Polylines: ") 
  (ssget) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) 
        ass (vla-get-ActiveSelectionSet adoc) 
        csp (vla-ObjectIDToObject adoc (vla-get-OwnerID (vla-item ass 0)))
	dvr (mapcar 'getvar '("DIMTXT" "DIMSCALE" "DIMGAP"))
	ofs (+ (* (car dvr) (cadr dvr)) (* (last dvr) 2)))
  (vlax-for ent ass 
    (setq par (vlax-curve-getParamAtPoint ent (vlax-curve-getEndPoint ent)))
    (cond ((= (vla-get-objectname ent) "AcDbPolyline") (setq pl t)
	   (while (> par 0) (setq pt (reverse
		(cons (vlax-curve-getFirstDeriv ent (- par 0.5))
		      (reverse (mapcar '(lambda (x) (vlax-curve-getPointAtParam ent x))
				       (list par (1- par) (- par 0.5)))))));setq
	       (if (null pts) (setq pts (list pt)) (setq pts (cons pt pts)));if
	     (setq par (1- par))));PLine
	  ((= (vla-get-objectname ent) "AcDbLine") (setq pl nil)
           (setq pt (vlax-curve-getPointAtParam ent (/ par 2))
		 pts (reverse (cons (vlax-curve-getFirstDeriv ent (- par 0.5))
				    (cons pt (mapcar '(lambda (x) (vlax-get ent x))
					      '(StartPoint EndPoint)))))));Line
	  (t (alert "\Wrong Selection!")));cond
    (while pts (setq dpt (last (setq wpt (if pl (car pts) pts)))
		     tpt (polar (caddr wpt) (+ (atan (/ (cadr dpt) (car dpt))) 0.785398) ofs)
		     dpts (mapcar 'vlax-3d-point (subst tpt (caddr wpt) wpt))
		     dim (vla-addDimAligned csp (car dpts) (cadr dpts) (caddr dpts)));setq
      (mapcar '(lambda (x y) (vlax-put-property dim x y))
              '(TextInsideAlign VerticalTextPosition) (list 0 acAbove))
      (setq pts (if pl (cdr pts) nil)));while 
  );vlax-for 
);end

[fixo]

Сообщение от Asys >Fatty Спасибо, жаль что только для замкнутых контуров

По просьбе трудящихся:

Код:

[Выделить все]

;; Program draw a dimension of all polygon segments
;; Polygon must be closed or opened
;; copyrights (c) 2005 Fatty T.O.H. all rights removed
;; (freeware)
;; A2005 Windows XP


;; helper functions : written by Fatty T.O.H.

;; ***  группировка списка   ***

(defun group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
	(repeat num (setq ls 
		    (cons (car lst) ls)
	      lst (cdr lst)))
	(setq ret (append ret (list (reverse ls)))
	      ls nil)))
    )
ret
  )

;; ***  координаты полилинии  ***

(defun get-vexs (pline_obj / verts)
      (setq verts (vlax-get pline_obj 'Coordinates)
	    verts
		  (cond
		    ((wcmatch (vlax-get pline_obj 'Objectname )
			     "AcDb2dPolyline,AcDb3dPolyline") 
		     (group-by-num verts 3)
		    )
		    ((eq (vlax-get pline_obj 'Objectname )
			     "AcDbPolyline") 
		     (group-by-num verts 2)
		    )
		    (T nil)
		  )
)
  ) 


;; ***  разность двух углов  ***

(defun dif-angle (ang1 ang2 / def)
  (set 'ang1
       (if (> ang2 (+ pi ang1))
	 (+ (* pi 2) ang1)
	 ang1
       )
  )
  (set 'ang2
       (if (> ang1 (+ pi ang2))
	 (+ (* pi 2) ang2)
	 ang2
       )
  )
  (setq def (- ang2 ang1))
)

;; ***  проверка на направление полилинии  ***
;; возвращает Т если полилиния нарисована против
;; часовой стрелки (angdir=0)
(defun ccw-test	(pt_list / angle_list)
  (setq	angle_list
	 (mapcar (function (lambda (x y)
			     (angle x y)
			   )
		 )
		 pt_list
		 (cdr pt_list)
	 )
  )
  (if (> (apply	'+
		(mapcar	(function (lambda (x y) (dif-angle x y)))
			angle_list
			(cdr angle_list)
		)
	 )
	 0
      )
    t
    nil
  )
)
;; ***  основная программа  ***

(defun C:dmp (/ acsp adoc cent_coords coords pl txt_coords)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq acsp (vla-get-modelspace adoc))
  (setq	pl (vlax-ename->vla-object
	     (car (entsel "\nУказать замкнутую полилинию \n"))
	   )
  )
  
  (setq	coords (get-vexs pl))
  (if (eq :vlax-true (vla-get-closed pl))
  (setq	coords (append coords (list (car coords)))))
  (if (ccw-test coords)(setq dop pi)(setq dop 0)) 
  (setq	cent_coords
	 (mapcar (function (lambda (x y)
			     (mapcar '/ (mapcar '+ x y) '(2 2 2))
			   )
		 )
		 coords
		 (cdr coords)
	 )
  )
  (setq	txt_coords
	 (mapcar (function (lambda (x y z)
			     (polar x (+ dop (angle y z) (/ pi 2)) 8.);вынос размерной линии изменить
			   )
		 )
		 cent_coords
		 coords
		 (cdr coords)
	 )
  )
  (mapcar (function (lambda (x y z)
		      (vla-adddimaligned acsp x y z)
		    )
	  )
	  (mapcar 'vlax-3d-point coords)
	  (mapcar 'vlax-3d-point (cdr coords))
	  (mapcar 'vlax-3d-point txt_coords)
  )
  (princ)
)

(prompt "\n\t***\tОБРАЗМЕРИВАНИЕ ПОЛИГОНОВ\t***\n")
(prompt "\nНабери в командной строке DMP для выполнения команды\n")

;TesT:
;;;(repeat 16
;;;  (C:dmp)
;;;  (princ))

[asys]

>Лентяй
>Fatty
[sm206]
Большой спасиба

[fixo]

Сообщение от Asys >Лентяй >Fatty [sm206] Большой спасиба

Спасибо за пиво

Fatty :P

[asys]

Мне не жалко :P
[ATTACH]1133609957.jpg[/ATTACH]

[AZIA]

не подумайте обо мне плохого но что делать с этими кодами?

[Кулик Алексей aka kpblc]

dwg.ru/art/8

[TanyaMJ]

Сообщение от Лентяй Asys, держите вашу прогу. Пришлось изменить почти всю логику и провозиться пару часов. Пользуйтесь и не забывайте утренне и нощно сугубо и трегубо благодарить меня за то, что я есть. Код: [Выделить все] (defun C:PlMDim (/ par dim pts dpt wpt tpt dpts) (prompt "\nSelect Polylines: ") (ssget) (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) ass (vla-get-ActiveSelectionSet adoc) csp (vla-ObjectIDToObject adoc (vla-get-OwnerID (vla-item ass 0))) dvr (mapcar 'getvar '("DIMTXT" "DIMSCALE" "DIMGAP")) ofs (+ (* (car dvr) (cadr dvr)) (* (last dvr) 2))) (vlax-for ent ass (setq par (vlax-curve-getParamAtPoint ent (vlax-curve-getEndPoint ent))) (cond ((= (vla-get-objectname ent) "AcDbPolyline") (setq pl t) (while (> par 0) (setq pt (reverse (cons (vlax-curve-getFirstDeriv ent (- par 0.5)) (reverse (mapcar '(lambda (x) (vlax-curve-getPointAtParam ent x)) (list par (1- par) (- par 0.5)))))));setq (if (null pts) (setq pts (list pt)) (setq pts (cons pt pts)));if (setq par (1- par))));PLine ((= (vla-get-objectname ent) "AcDbLine") (setq pl nil) (setq pt (vlax-curve-getPointAtParam ent (/ par 2)) pts (reverse (cons (vlax-curve-getFirstDeriv ent (- par 0.5)) (cons pt (mapcar '(lambda (x) (vlax-get ent x)) '(StartPoint EndPoint)))))));Line (t (alert "\Wrong Selection!")));cond (while pts (setq dpt (last (setq wpt (if pl (car pts) pts))) tpt (polar (caddr wpt) (+ (atan (/ (cadr dpt) (car dpt))) 0.785398) ofs) dpts (mapcar 'vlax-3d-point (subst tpt (caddr wpt) wpt)) dim (vla-addDimAligned csp (car dpts) (cadr dpts) (caddr dpts)));setq (mapcar '(lambda (x y) (vlax-put-property dim x y)) '(TextInsideAlign VerticalTextPosition) (list 0 acAbove)) (setq pts (if pl (cdr pts) nil)));while );vlax-for );end

[NemoSUN]

Сообщение от Лентяй Asys, держите вашу прогу. Пришлось изменить почти всю логику и провозиться пару часов. Пользуйтесь и не забывайте утренне и нощно сугубо и трегубо благодарить меня за то, что я есть. Код: [Выделить все] (defun C:PlMDim (/ par dim pts dpt wpt tpt dpts) (prompt "\nSelect Polylines: ") (ssget) (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) ass (vla-get-ActiveSelectionSet adoc) csp (vla-ObjectIDToObject adoc (vla-get-OwnerID (vla-item ass 0))) dvr (mapcar 'getvar '("DIMTXT" "DIMSCALE" "DIMGAP")) ofs (+ (* (car dvr) (cadr dvr)) (* (last dvr) 2))) (vlax-for ent ass (setq par (vlax-curve-getParamAtPoint ent (vlax-curve-getEndPoint ent))) (cond ((= (vla-get-objectname ent) "AcDbPolyline") (setq pl t) (while (> par 0) (setq pt (reverse (cons (vlax-curve-getFirstDeriv ent (- par 0.5)) (reverse (mapcar '(lambda (x) (vlax-curve-getPointAtParam ent x)) (list par (1- par) (- par 0.5)))))));setq (if (null pts) (setq pts (list pt)) (setq pts (cons pt pts)));if (setq par (1- par))));PLine ((= (vla-get-objectname ent) "AcDbLine") (setq pl nil) (setq pt (vlax-curve-getPointAtParam ent (/ par 2)) pts (reverse (cons (vlax-curve-getFirstDeriv ent (- par 0.5)) (cons pt (mapcar '(lambda (x) (vlax-get ent x)) '(StartPoint EndPoint)))))));Line (t (alert "\Wrong Selection!")));cond (while pts (setq dpt (last (setq wpt (if pl (car pts) pts))) tpt (polar (caddr wpt) (+ (atan (/ (cadr dpt) (car dpt))) 0.785398) ofs) dpts (mapcar 'vlax-3d-point (subst tpt (caddr wpt) wpt)) dim (vla-addDimAligned csp (car dpts) (cadr dpts) (caddr dpts)));setq (mapcar '(lambda (x y) (vlax-put-property dim x y)) '(TextInsideAlign VerticalTextPosition) (list 0 acAbove)) (setq pts (if pl (cdr pts) nil)));while );vlax-for );end

Даёт ошибку в AutoCAD 2010 (Eng, x64)

Код:

[Выделить все]

Command: PlMDim

Select Polylines:
Select objects: Specify opposite corner: 6 found

Select objects:
; error: no function definition: VLAX-GET-ACAD-OBJECT

[Кулик Алексей aka kpblc]

(vl-load-com) в самом начале добавь.

[NemoSUN]

Сообщение от Кулик Алексей aka kpblc (vl-load-com) в самом начале добавь.

Добавил.

Теперь если выбираю объект, то:
Command: PlMDim

Select Polylines:
Select objects: 1 found

Select objects:
nil

[VVA]

NemoSUN, Проверил, код рабочий (Автокад 2013). Могу предположить, что у тебя или старые 2d или 3d полилинии. Скопируй в командную строку код

Код:

[Выделить все]

(cdr(assoc 0 (entget(car(entsel)))))

Должен увидеть текст "LWPOLYLINE" Если это не так _CONVERTPOLY в помощь

[NemoSUN]

Сообщение от VVA NemoSUN, Проверил, код рабочий (Автокад 2013). Могу предположить, что у тебя или старые 2d или 3d полилинии. Скопируй в командную строку код Код: [Выделить все] (cdr(assoc 0 (entget(car(entsel))))) Должен увидеть текст "LWPOLYLINE" Если это не так _CONVERTPOLY в помощь

Код:

[Выделить все]

(cdr(assoc 0 (entget(car(entsel)))))

проходит.

Приложил пример файла.

[koMon]

замкнутость

[NemoSUN]

Сообщение от koMon замкнутость

О чём это? У меня все контуры замкнуты.

[koMon]

насколько я понимаю эта программа не проставляет размеры сегментов у замкнутой полилинии, ну по крайней мере у меня не проставляет)

----- добавлено через ~2 мин. -----

Сообщение от NemoSUN У меня все контуры замкнуты.

ну вообще-то не все: 48, 49 не замкнуты. но и в них не проставляет так же)

[Boxa]

Тему посмотрел по диагонали.... и вроде никто про команду "QDIM" ("БРАЗМЕР") еще не писал... NemoSUN, может быть Вам ее будет достаточно?

[VVA]

Сообщение от koMon замкнутость

Оно. Переделал, чтобы по другому определялось количество вершин. Замкнутый сегмент не обрабатывается

Код:

[Выделить все]

(defun C:PlMDim (/ par dim pts dpt wpt tpt dpts lib:pline-get-verts pl:group-by-num vx)
  (vl-load-com)
;;;* Ф-ция lib:pline-get-verts
;;;* Возвращает координаты вершин полилинии
;;;* Взята или на autocad.ru или на dwg.ru 
;;;* Arguments [Type]:
;;;   pline_obj = Object [Vla-Object]
;;;* Возвращает [Type]:
;;;   список координат вида ((90.987 183.524) (93.2774 206.991) (123.052 208.708) (140.23 184.382) (111.6 170.073))
(defun lib:pline-get-verts (pline_obj)
  (if (= (type pline_obj) 'Ename)
    (setq pline_obj (vlax-ename->vla-object pline_obj))
  ) ;_ end of if
      (cond
        ((wcmatch (vlax-get pline_obj 'Objectname )
           "AcDb2dPolyline,AcDb3dPolyline")
         (pl:group-by-num (vlax-get pline_obj 'Coordinates) 3)
        )
        ((eq (vlax-get pline_obj 'Objectname )
           "AcDbPolyline")
         (pl:group-by-num (vlax-get pline_obj 'Coordinates) 2)
        )
       ((eq (vlax-get pline_obj 'Objectname )
           "AcDbLine")
         (list (vlax-curve-getstartpoint pline_obj)(vlax-curve-getendpoint pline_obj))
        )
        (T nil)))
  (defun pl:group-by-num (lst num / ls ret)
(if (= (rem (length lst) num ) 0)
 (progn (setq ls nil)
  (repeat (/ (length lst) num)
    (repeat num (setq ls (cons (car lst) ls) lst (cdr lst)))
  (setq ret (append ret (list (reverse ls))) ls nil)))) ret)

  (prompt "\nSelect Polylines: ") 
  (ssget) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) 
        ass (vla-get-ActiveSelectionSet adoc) 
        csp (vla-ObjectIDToObject adoc (vla-get-OwnerID (vla-item ass 0)))
	dvr (mapcar 'getvar '("DIMTXT" "DIMSCALE" "DIMGAP"))
	ofs (+ (* (car dvr) (cadr dvr)) (* (last dvr) 2)))
  (vlax-for ent ass
      (setq vx (lib:pline-get-verts ent))
;;; (if (eq (vla-get-closed ent) :vlax-true)
;;;     (setq vx (append vx (list (car vx)))))
    (setq par (- (length vx) 1))
;;;    (setq par (vlax-curve-getParamAtPoint ent (vlax-curve-getEndPoint ent)))
    (cond ((= (vla-get-objectname ent) "AcDbPolyline") (setq pl t)
	   (while (> par 0) (setq pt (reverse
		(cons (vlax-curve-getFirstDeriv ent (- par 0.5))
		      (reverse (mapcar '(lambda (x) (vlax-curve-getPointAtParam ent x))
				       (list par (1- par) (- par 0.5)))))));setq
	       (if (null pts) (setq pts (list pt)) (setq pts (cons pt pts)));if
	     (setq par (1- par))));PLine
	  ((= (vla-get-objectname ent) "AcDbLine") (setq pl nil)
           (setq pt (vlax-curve-getPointAtParam ent (/ par 2))
		 pts (reverse (cons (vlax-curve-getFirstDeriv ent (- par 0.5))
				    (cons pt (mapcar '(lambda (x) (vlax-get ent x))
					      '(StartPoint EndPoint)))))));Line
	  (t (alert "\Wrong Selection!")));cond
    (while pts (setq dpt (last (setq wpt (if pl (car pts) pts)))
		     tpt (polar (caddr wpt) (+ (atan (/ (cadr dpt) (car dpt))) 0.785398) ofs)
		     dpts (mapcar 'vlax-3d-point (subst tpt (caddr wpt) wpt))
		     dim (vla-addDimAligned csp (car dpts) (cadr dpts) (caddr dpts)));setq
      (mapcar '(lambda (x y) (vlax-put-property dim x y))
              '(TextInsideAlign VerticalTextPosition) (list 0 acAbove))
      (setq pts (if pl (cdr pts) nil)));while 
  );vlax-for 
);end

----- добавлено через ~2 ч. -----
Еще одна версия от marko_ribar

Код:

[Выделить все]

(defun c:pdim ( / ListClockwise-p ch plSet pLlst vLst oldOsn cAng cDis cPt )
;;; Polyline Dimension by marko_ribar  
;;;https://www.cadtutor.net/forum/topic/54351-automatic-distance-between-polygon-vertices/#comment-451128
;;; posted https://forum.dwg.ru/forumdisplay.php?f=13  
 (vl-load-com) 
 (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)
)

[1958]

Подправлено 5 сентября.
Мой вариант включает также размеры дуговых сегментов:

Код:

[Выделить все]

 ;;; Образмеривание полилинии, автор - 1958
;;; 5 сентября 2022г.
(defun c:dimPl (/ ccol ent poly obj dimObj p1 p2 cPt)
 (vl-load-com)
 (setq ccol (getvar "cecolor"))
 (setvar "cecolor" "5")
 (setq acadObj    (vlax-get-acad-object)
       doc        (vla-get-ActiveDocument acadObj)
       modelSpace (vla-get-ModelSpace doc)
 )
 (setq ent  (car (entsel "\nУкажите полилинию "))
       poly (vlax-invoke (vlax-ename->vla-object ent) 'explode)
 )
 (foreach obj poly
  (coord)
  (cond ((eq (vla-get-Objectname obj) "AcDbLine")
         (setq dimObj (vla-AddDimAligned modelSpace
                                         (vlax-3d-point p1)
                                         (vlax-3d-point p2)
                                         (vlax-3d-point cPt)
                      )
         )
        )
        ((eq (vla-get-Objectname obj) "AcDbArc")
         (setq
          dimObj (vla-AddDimArc modelSpace
                                (vlax-3d-point (vlax-get obj 'Center))
                                (vlax-3d-point p1)
                                (vlax-3d-point p2)
                                (vlax-3d-point cPt)
                 )
         )
        )
  )
  (vla-delete obj)
 )
 (setvar "cecolor" ccol)
 (princ)
)
(defun coord (/ dis pc ang)
 (setq p1  (vlax-get obj 'StartPoint)
       p2  (vlax-get obj 'EndPoint)
       dis (vlax-curve-getDistAtPoint obj p2)
       pc  (vlax-curve-getPointAtDist obj (/ dis 2))
       ang (- (angle '(0. 0. 0.)
                     (vlax-curve-getfirstderiv
                      obj
                      (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj pc))
                     )
              )
              (/ pi 2)
           )
 )
 (setq cPt (polar pc ang (* 2.0 (getvar "DIMTXT"))))
)