Можно ли автоматически проставить на полилинии размеры?

B2Slow · 02.12.2005, 08:00

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

NemoSUN · 25.08.2022, 18:29

Цитата:

Сообщение от Лентяй

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 · 25.08.2022, 19:46

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

NemoSUN · 26.08.2022, 15:21

Цитата:

Сообщение от Кулик Алексей aka kpblc

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

Добавил.

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

Select Polylines:
Select objects: 1 found

Select objects:
nil

VVA · 29.08.2022, 13:54

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

Код:

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

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

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

NemoSUN · 29.08.2022, 15:13

Цитата:

Сообщение от VVA

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

Код:

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

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

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

Код:

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

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

проходит.

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

koMon · 29.08.2022, 16:30

замкнутость

NemoSUN · 30.08.2022, 16:06

Цитата:

Сообщение от koMon

замкнутость

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

koMon · 30.08.2022, 16:58

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

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

Цитата:

Сообщение от NemoSUN

У меня все контуры замкнуты.

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

Boxa · 30.08.2022, 18:30

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

VVA · 01.09.2022, 08:58

Цитата:

Сообщение от 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 · 04.09.2022, 17:49

Подправлено 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"))))
)

02.12.2005, 08:00
Можно ли автоматически проставить на полилинии размеры? B2Slow Иркутск Регистрация: 20.06.2005 Сообщений: 57 Нужно автоматически проставить размер линий или сегментов полилинии Aligned Dimension-ом с привязкой к центру сегмента, выделяя сразу несколько полилиний или линий.
Просмотров: 17422

	Реклама i