Расстояние от начала полилинии до опеделенной точки

bimari · 20.10.2006, 15:53

Подскажите, пожалуйста как в 2006 акаде можно было определить расстояние от начала полилинии до любой ее точки. Было бы хорошо, если бы кликнув на эту точку появлялся Leader с расстоянием. Заранее спасибо!

Zouss · 20.10.2006, 16:25

это вам в соседнюю ветку, где про среднюю линию, непосредственно к господам VVA и Лентяй, ибо в строках ихних прог видятся мне ростки решения
единственно уточните, что для вас является началом полилинии - точка с которой вы начинали построение этой самой полилинии или, в общем случае, одна из двух точек которые, если они в паре традиционно называют концами линии поли-ли или непили-ли

VVA · 20.10.2006, 17:31

Пробуй

Код:

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

(defun C:DST ( / adoc *error* crvs eps dL pts pt1 pt2 ptc n osm)
(defun *error* (msg)(vl-cmdf "_redrawall")(vla-EndUndoMark adoc)
  (setvar "OSMODE" osm))
(defun dr_st ( pt ang color / pt1 pt2 )
  (setq pt1 (polar pt (+ ang 2.35619 ) (* 0.03 (getvar "VIEWSIZE"))))
  (setq pt2 (polar pt (+ ang 3.92699) (* 0.03 (getvar "VIEWSIZE"))))
  (grvecs (list color pt1 pt pt pt2)))
(defun dr_kr ( pt color / pt11 pt12 pt21 pt22 len )
(setq len (* 0.02 (getvar "VIEWSIZE"))
pt11 (polar pt 3.92699 len) pt12 (polar pt 0.785398 len)
pt21 (polar pt 5.49779 len) pt22 (polar pt 2.35619 len))
(grvecs (list color pt11 pt12 pt21 pt22)))  
(vl-load-com)(setq osm (getvar "OSMODE"))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-StartUndoMark adoc)(setvar "CMDECHO" 0)(setvar "OSMODE" 512)
(setq pt (getpoint "\nУкажите точку на кривой <выход> : "))
(if (setq ss (if pt (ssget pt '((0 . "*LINE,ARC"))) nil))
  (progn (setq en (ssname ss 0)
    crv (vlax-ename->vla-object en)
     pt (vlax-curve-getclosestpointto crv (trans pt 1 0))
     ds (vlax-curve-getDistAtParam crv (vlax-curve-getEndParam crv))
    ds1 (vlax-curve-getDistAtParam crv (vlax-curve-getParamAtPoint crv pt)))
   (dr_st (trans pt 0 1)(angle (trans pt 0 1)(trans
   (vlax-curve-getPointAtParam crv (+ (vlax-curve-getParamAtPoint crv pt) 0.0001))0 1))1)
   (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 1)
   (initget "Поменять Change _C C")(princ "\nДлинна объекта ")(princ ds1)
   (princ " [Поменять начало] <готово>:")(setq en (getkword))	    
   (if (= en "C")(progn (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 0)
   (dr_kr (trans (vlax-curve-getEndPoint crv) 0 1) 1)
   (setq ds1 (- ds ds1))))(princ "\nВторая точка выноски :")
   (vl-cmdf "_LEADER" (trans pt 0 1) pause "" (rtos ds1 2 3) "")))
  (setvar "OSMODE" osm)(vla-EndUndoMark adoc)(vl-cmdf "_redrawall")(princ))
(princ "\nНаберите в командной строке DST")

Profan · 20.10.2006, 17:36

Интересно, Лентяй покороче сможет написать?

Zouss · 20.10.2006, 17:45

хы, великая идея измерений у кого длиннее приобретает смысл прямопротивоположный изначальному
пожалуй я смогу написать эту прогу за 30 строк ?)

bimari · 25.10.2006, 09:33

Спасибо огромное, именно то, что искала

Очень облегчило работу!

KAI · 17.01.2007, 04:53

>> VVA

Для достаточно больших координат объектов в WSC, например:
X=22685606.13397148 Y=5431154.563627330 Z=0.0000000000
Наблюдается следующая картина:
1. для линий и 2d и 3d полилиний Acad иногда не может найти параметры, особенно это проявляется в UCS, и соответственно программа вываливаетя.
2. сглаженные 2d и 3d полилинии дают меньше ошибок.
3. если координаты близки к 0,0.0 все работае как часы.

VVA · 17.01.2007, 11:04

> KAI
Когда здесь мы пытались заставить PL-DIV работать в UCS, то там глючила vlax-curve-getDistAtPoint. Пямятуя об этом в DST использовал vlax-curve-getDistAtParam. Мыслей никаких. Пришли почтой рисунок, посмотрю, что вылетает.

VVA · 19.01.2007, 15:39

Сбоила vlax-curve-getParamAtPoint, причем на каком-то участке возвращает параметр, на на каком-то нет

Пока выход нашел такой: line ,3d polyline, 2d и LW polyline не сглаженные и без дуговых сегментов обрабатываю по правилам геометрии (принадлежность точки прямой).

Код:

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

;http://forum.dwg.ru/showthread.php?p=113702#post113702
(defun C:DST (/ adoc *error* crvs eps dL pts pt1 pt2 ptc n osm vx p1 p2)
  (defun *error* (msg)(princ msg)(vl-cmdf "_redrawall")(vla-EndUndoMark adoc)
    (setvar "OSMODE" osm))
  (defun dr_st (pt ang color / pt1 pt2)
    (setq pt1 (polar pt (+ ang 2.35619) (* 0.03 (getvar "VIEWSIZE"))))
    (setq pt2 (polar pt (+ ang 3.92699) (* 0.03 (getvar "VIEWSIZE"))))
    (grvecs (list color pt1 pt pt pt2)))
  (defun dr_kr (pt color / pt11 pt12 pt21 pt22 len)
    (setq len  (* 0.02 (getvar "VIEWSIZE"))
	  pt11 (polar pt 3.92699 len)
	  pt12 (polar pt 0.785398 len)
	  pt21 (polar pt 5.49779 len)
	  pt22 (polar pt 2.35619 len))
    (grvecs (list color pt11 pt12 pt21 pt22)))
(defun getblg ( pl / blglist i n ent_data tmp_ent)
(setq ent_data (entget pl))
(cond ((= (cdr(assoc 0 ent_data)) "LWPOLYLINE")
  (setq  blglist (mapcar 'cdr (vl-remove-if-not(function(lambda(x)(= 42(car x)))) ent_data))))
(t (setq tmp_ent pl)
 (while (/= "SEQEND"  (cdr(assoc 0 (entget(setq tmp_ent (entnext tmp_ent))))))
  (setq  blglist (append blglist (list (cdr(assoc 42 (entget tmp_ent)))))))))
   blglist)
  (vl-load-com)(setq osm (getvar "OSMODE"))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-StartUndoMark adoc)
  (setvar "CMDECHO" 0)(setvar "OSMODE" 512)
  (setq pt (getpoint "\nУкажите точку на кривой <выход> : "))
  (if (setq ss (if pt
		 (ssget pt '((0 . "*LINE,ARC")))
		 nil)
      )
    (progn
      (setq en	(ssname ss 0)
	    crv	(vlax-ename->vla-object en)
	    pt	(vlax-curve-getclosestpointto crv (trans pt 1 0))
	    ds	(vlax-curve-getDistAtParam crv (vlax-curve-getEndParam crv)))
      (cond ((= (vla-get-ObjectName crv) "AcDbLine")
	     (setq ds1 (distance (cdr(assoc 10 (entget en))) pt)))
	    ((or (= (vla-get-ObjectName crv) "AcDb3dPolyline")
                 (and
                     (= (vla-get-ObjectName crv) "AcDb2dPolyline")
                     (/= (logand (cdr(assoc 70 (entget en))) 2) 2) ;_Fit
                     (/= (logand (cdr(assoc 70 (entget en))) 4) 4) ;_Spline
                     (vl-every 'zerop (getblg en))
                     )
                 (and
                     (= (vla-get-ObjectName crv) "AcDbPolyline")
                     (vl-every 'zerop (getblg en))
                     )
                 )
	     (setq vx ((lambda ( / i lst)(while (<= (setq i (if i (1+ i) 0))(vlax-curve-getEndParam crv))
                       (setq lst (append lst (list (vlax-curve-getPointAtParam crv i))))) lst)))
	     (setq p1 (car vx) vx (cdr vx) ds1 0)
	     (while (and (setq p2 (car vx))
			 (not (equal (+ (distance Pt P1) (distance Pt P2)) (distance P1 P2) 0.00001))
			 )
	       (setq vx (cdr vx) ds1 (+ ds1 (distance P1 P2)) p1 p2)
	       )
	       (setq ds1 (+ ds1 (distance P1 Pt))))
	    (t (setq  ds1 (vlax-curve-getDistAtParam
			    crv (vlax-curve-getParamAtPoint crv pt)))))
      (dr_st (trans pt 0 1)
	     (angle (trans pt 0 1)
		    (trans (vlax-curve-getPointAtParam crv
			(+ (vlax-curve-getParamAtDist crv ds1) 0.0001))
		      0  1)) 1)
      (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 1)
      (initget "Поменять Change _C C")
      (princ "\nДлинна объекта ")(princ ds1)
      (princ " [Поменять начало] <готово>:")(setq en (getkword))
      (if (= en "C")
	(progn (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 0)
	       (dr_kr (trans (vlax-curve-getEndPoint crv) 0 1) 1)
	       (setq ds1 (- ds ds1))
	)
      )
      (princ "\nВторая точка выноски :")
      (vl-cmdf "_LEADER"
	       (trans pt 0 1)
	       pause
	       ""
	       (rtos ds1 2 3)
	       "" )))
  (setvar "OSMODE" osm)
  (vla-EndUndoMark adoc)
  (vl-cmdf "_redrawall")
  (princ))
(princ "\nНаберите в командной строке DST")

skkkk · 06.12.2010, 17:22

Не смог разобраться, какая переменная из #9 хранит в себе значение длины полилинии от начала до указанной точки (указанная точка в данном случае хранится в переменной a)? Мне нужно создавать мультивыноску, содержащую имя слоя, на котором расположена полилиния и длину. Как выяснить имя слоя? Есть мысль проверять принадлежность точки полилинии и затем запрашивать имя ее слоя. Или можно проще?

Код:

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

(defun c:mymleader (/ a)
(setq a (getpoint "Укажите точку вставки выноски <Выход>: "))
(command "_mleader" a pause "_e" "0" (strcat "Имя слоя " "Длина"))
)

VVA · 06.12.2010, 18:09

Цитата:

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

Не смог разобраться, какая переменная из #9 хранит в себе значение длины полилинии от начала до указанной точки

dsl

Цитата:

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

Как выяснить имя слоя?

(vla-get-layer crv)
Обновленный вариант команды DST
Чертит текущим стилем мультивыноски

Код:

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

(defun C:DST (/ adoc *error* crvs eps dL pts pt1 pt2 ptc n osm vx p1 p2)
;;;http://forum.dwg.ru/showthread.php?p=113702#post113702 
  (defun *error* (msg)(princ msg)(vl-cmdf "_redrawall")(vla-EndUndoMark adoc)
    (setvar "OSMODE" osm))
  (defun dr_st (pt ang color / pt1 pt2)
    (setq pt1 (polar pt (+ ang 2.35619) (* 0.03 (getvar "VIEWSIZE"))))
    (setq pt2 (polar pt (+ ang 3.92699) (* 0.03 (getvar "VIEWSIZE"))))
    (grvecs (list color pt1 pt pt pt2)))
  (defun dr_kr (pt color / pt11 pt12 pt21 pt22 len)
    (setq len  (* 0.02 (getvar "VIEWSIZE"))
	  pt11 (polar pt 3.92699 len)
	  pt12 (polar pt 0.785398 len)
	  pt21 (polar pt 5.49779 len)
	  pt22 (polar pt 2.35619 len))
    (grvecs (list color pt11 pt12 pt21 pt22)))
(defun getblg ( pl / blglist i n ent_data tmp_ent)
(setq ent_data (entget pl))
(cond ((= (cdr(assoc 0 ent_data)) "LWPOLYLINE")
  (setq  blglist (mapcar 'cdr (vl-remove-if-not(function(lambda(x)(= 42(car x)))) ent_data))))
(t (setq tmp_ent pl)
 (while (/= "SEQEND"  (cdr(assoc 0 (entget(setq tmp_ent (entnext tmp_ent))))))
  (setq  blglist (append blglist (list (cdr(assoc 42 (entget tmp_ent)))))))))
   blglist)
  (vl-load-com)(setq osm (getvar "OSMODE"))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-StartUndoMark adoc)
  (setvar "CMDECHO" 0)(setvar "OSMODE" 512)
  (setq pt (getpoint "\nУкажите точку на кривой <выход> : "))
  (if (setq ss (if pt
		 (ssget pt '((0 . "*LINE,ARC")))
		 nil)
      )
    (progn
      (setq en	(ssname ss 0)
	    crv	(vlax-ename->vla-object en)
	    pt	(vlax-curve-getclosestpointto crv (trans pt 1 0))
	    ds	(vlax-curve-getDistAtParam crv (vlax-curve-getEndParam crv)))
      (cond ((= (vla-get-ObjectName crv) "AcDbLine")
	     (setq ds1 (distance (cdr(assoc 10 (entget en))) pt)))
	    ((or (= (vla-get-ObjectName crv) "AcDb3dPolyline")
                 (and
                     (= (vla-get-ObjectName crv) "AcDb2dPolyline")
                     (/= (logand (cdr(assoc 70 (entget en))) 2) 2) ;_Fit
                     (/= (logand (cdr(assoc 70 (entget en))) 4) 4) ;_Spline
                     (vl-every 'zerop (getblg en))
                     )
                 (and
                     (= (vla-get-ObjectName crv) "AcDbPolyline")
                     (vl-every 'zerop (getblg en))
                     )
                 )
	     (setq vx ((lambda ( / i lst)(while (<= (setq i (if i (1+ i) 0))(vlax-curve-getEndParam crv))
                       (setq lst (append lst (list (vlax-curve-getPointAtParam crv i))))) lst)))
	     (setq p1 (car vx) vx (cdr vx) ds1 0)
	     (while (and (setq p2 (car vx))
			 (not (equal (+ (distance Pt P1) (distance Pt P2)) (distance P1 P2) 0.00001))
			 )
	       (setq vx (cdr vx) ds1 (+ ds1 (distance P1 P2)) p1 p2)
	       )
	       (setq ds1 (+ ds1 (distance P1 Pt))))
	    (t (setq  ds1 (vlax-curve-getDistAtParam
			    crv (vlax-curve-getParamAtPoint crv pt)))))
      (dr_st (trans pt 0 1)
	     (angle (trans pt 0 1)
		    (trans (vlax-curve-getPointAtParam crv
			(+ (vlax-curve-getParamAtDist crv ds1) 0.0001))
		      0  1)) 1)
      (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 1)
      (initget "Поменять Change _C C")
      (princ "\nДлинна объекта ")(princ ds1)
      (princ " [Поменять начало] <готово>:")(setq en (getkword))
      (if (= en "C")
	(progn (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 0)
	       (dr_kr (trans (vlax-curve-getEndPoint crv) 0 1) 1)
	       (setq ds1 (- ds ds1))
	)
      )
      (princ "\nВторая точка выноски :")
      (if (getvar "CMLEADERSTYLE")
       (draw-mleader
         pt ;_ начальная точка
         pause ;_запрос второй точкм
         (list
           (strcat "Имя слоя " (vla-get-layer crv)) ;_1-я строка
           (strcat "Длина " (rtos ds1 2 3))  ;_2-я строка длина до 3 знаков после запятой
           )
          1.5 ;_Вытота текста
          0.87 ;_Значение коэффициента см
;;; тему http://forum.dwg.ru/showpost.php?p=656758&postcount=51
         0.2 ;_отступ 1-го параграфа (форматтирование \\pxa)
         )
      (vl-cmdf "_LEADER"
	       (trans pt 0 1)
	       pause
	       ""
	       (rtos ds1 2 3)
	       "" )
        )
      )
    )
  (setvar "OSMODE" osm)
  (vla-EndUndoMark adoc)
  (vl-cmdf "_redrawall")
  (princ))
  (defun draw-mleader (pt1 pt2 strlist Htxt koeff abz / dic mlst i)
  ;;; pt1 - начальная точка UCS
  ;;; pt2 - конечная точка UCS
  ;;; strlist - список строк
  ;;; Htxt - высота текста
  ;;; koeff - коэфф форматирования pxe или nil
  ;;; abz - коэфф форматирования абзаца \\pa или Nil
  ;;;(draw-mleader (setq pt1(getpoint))(getpoint pt1)(list "Пример" "Минскинжпроект" "Третья строка") 1.5 0.9 nil)
 ;;; Стиль мультивыноски текущий
  (setq i 0)
  (command
    "_mleader"
    "_h"
    "_none"
    pt1
    "_none"
    pt2
  (strcat (if koeff (strcat "\\px"
                              (if abz (strcat "a"(VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR abz))",") "")
                              "se" (VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR koeff))";") "")   ;;;"\\pxse0.87;"
;;;            "\\pa0.15;" (car strlist) "\\pa0;"
              (car strlist)
    )
    )
  (while (> (getvar "CMDACTIVE") 0) (command ""))
  (setq dic (vlax-ename->vla-object (entlast)))
  (vla-put-TextString dic
    (strcat (if koeff (strcat "\\px"
                              (if abz (strcat "a"(VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR abz))",") "")
                              "se" (VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR koeff))";") "")   ;;;"\\pxse0.87;"
;;;            "\\pa0.15;" (car strlist) "\\pa0;"
              (car strlist)
;;;              (if abz "\\pa0;" "")
            (apply 'strcat
                   (mapcar '(lambda (x) (strcat "\\P" (if (= (setq i (1+ i)) 1)(if abz "\\pa0;" "")   "")  x)) (cdr strlist))
            ) ;_ end of apply
    ) ;_ end of strcat
  )
    (vla-put-TextHeight dic Htxt)
    dic
  )
  (defun mip-conv-to-str (dat)
      (cond ((= (type dat) 'INT) (setq dat (itoa dat)))
            ((= (type dat) 'REAL) (setq dat (rtos dat 2 12)))
            ((null dat) (setq dat ""))
            (t (setq dat (vl-princ-to-string dat)))
      ) ;_ end of cond
    ) ;_ end of defun
(princ "\nНаберите в командной строке DST")

Вариант с запросом на предварительный выбор кривой

Код:

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

(defun C:DSTS (/ adoc *error* crvs eps dL pts pt1 pt2 ptc n osm vx p1 p2)
  ;;; Расстояние от начала полилинии до опеделенной точки
  ;;; Запрос выбора полилинии
  ;;; http://forum.dwg.ru/showthread.php?t=8713
  ;;; Отмерить по линии расстояние и поставить точку
  ;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=49398
   (defun *error* (msg)(if mut (setvar 'NOMUTT mut))(princ msg)
    (vl-cmdf "_redrawall")(vla-EndUndoMark adoc)(setvar "OSMODE" osm))
  (defun dr_st (pt ang color / pt1 pt2)
    (setq pt1 (polar pt (+ ang 2.35619) (* 0.03 (getvar "VIEWSIZE"))))
    (setq pt2 (polar pt (+ ang 3.92699) (* 0.03 (getvar "VIEWSIZE"))))
    (grvecs (list color pt1 pt pt pt2)))
  (defun dr_kr (pt color / pt11 pt12 pt21 pt22 len)
    (setq len  (* 0.02 (getvar "VIEWSIZE"))
	  pt11 (polar pt 3.92699 len)
	  pt12 (polar pt 0.785398 len)
	  pt21 (polar pt 5.49779 len)
	  pt22 (polar pt 2.35619 len))
    (grvecs (list color pt11 pt12 pt21 pt22)))
(defun getblg ( pl / blglist i n ent_data tmp_ent)
(setq ent_data (entget pl))
(cond ((= (cdr(assoc 0 ent_data)) "LWPOLYLINE")
  (setq  blglist (mapcar 'cdr (vl-remove-if-not(function(lambda(x)(= 42(car x)))) ent_data))))
(t (setq tmp_ent pl)
 (while (/= "SEQEND"  (cdr(assoc 0 (entget(setq tmp_ent (entnext tmp_ent))))))
  (setq  blglist (append blglist (list (cdr(assoc 42 (entget tmp_ent)))))))))
   blglist)
  (vl-load-com)(setq osm (getvar "OSMODE"))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-StartUndoMark adoc)
  (setvar "CMDECHO" 0)
  (and
      (progn
        (setq mut (getvar 'NOMUTT))
        (setvar 'NOMUTT 1)
        (princ "\nВыберите кривую: ")
        (setq ss (ssget "_:E:S" (list (cons 0 "*LINE,ARC")(cons 410 (getvar 'CTAB)))))
        (setvar 'NOMUTT mut) ss
      )
  (if (setq pt (getpoint "\nУкажите точку на кривой <выход> : "))
    (progn
      (setq en	(ssname ss 0)
	    crv	(vlax-ename->vla-object en)
	    pt	(vlax-curve-getclosestpointto crv (trans pt 1 0))
	    ds	(vlax-curve-getDistAtParam crv (vlax-curve-getEndParam crv)))
      (cond ((= (vla-get-ObjectName crv) "AcDbLine")
	     (setq ds1 (distance (cdr(assoc 10 (entget en))) pt)))
	    ((or (= (vla-get-ObjectName crv) "AcDb3dPolyline")
                 (and
                     (= (vla-get-ObjectName crv) "AcDb2dPolyline")
                     (/= (logand (cdr(assoc 70 (entget en))) 2) 2) ;_Fit
                     (/= (logand (cdr(assoc 70 (entget en))) 4) 4) ;_Spline
                     (vl-every 'zerop (getblg en))
                     )
                 (and
                     (= (vla-get-ObjectName crv) "AcDbPolyline")
                     (vl-every 'zerop (getblg en))
                     )
                 )
	     (setq vx ((lambda ( / i lst)(while (<= (setq i (if i (1+ i) 0))(vlax-curve-getEndParam crv))
                       (setq lst (append lst (list (vlax-curve-getPointAtParam crv i))))) lst)))
	     (setq p1 (car vx) vx (cdr vx) ds1 0)
	     (while (and (setq p2 (car vx))
			 (not (equal (+ (distance Pt P1) (distance Pt P2)) (distance P1 P2) 0.00001))
			 )
	       (setq vx (cdr vx) ds1 (+ ds1 (distance P1 P2)) p1 p2)
	       )
	       (setq ds1 (+ ds1 (distance P1 Pt))))
	    (t (setq  ds1 (vlax-curve-getDistAtParam
			    crv (vlax-curve-getParamAtPoint crv pt)))))
      (dr_st (trans pt 0 1)
	     (angle (trans pt 0 1)
		    (trans (vlax-curve-getPointAtParam crv
			(+ (vlax-curve-getParamAtDist crv ds1) 0.0001))
		      0  1)) 1)
      (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 1)
      (initget "Поменять Change _C C")
      (princ "\nДлинна объекта ")(princ ds1)
      (princ " [Поменять начало] <готово>:")(setq en (getkword))
      (if (= en "C")
	(progn (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 0)
	       (dr_kr (trans (vlax-curve-getEndPoint crv) 0 1) 1)
	       (setq ds1 (- ds ds1))
	)
      )
      (princ "\nВторая точка выноски :")
      (if (getvar "CMLEADERSTYLE")
       (draw-mleader
         pt ;_ начальная точка
         pause ;_запрос второй точкм
         (list
           (strcat "Имя слоя " (vla-get-layer crv)) ;_1-я строка
           (strcat "Длина " (rtos ds1 2 3))  ;_2-я строка длина до 3 знаков после запятой
           )
          1.5 ;_Вытота текста
          0.87 ;_Значение коэффициента см
;;; тему http://forum.dwg.ru/showpost.php?p=656758&postcount=51
         0.2 ;_отступ 1-го параграфа (форматтирование \\pxa)
         )
      (vl-cmdf "_LEADER"
	       (trans pt 0 1)
	       pause
	       ""
	       (rtos ds1 2 3)
	       "" )
        )
      )
    )
    )
  (setvar "OSMODE" osm)
  (vla-EndUndoMark adoc)
  (vl-cmdf "_redrawall")
  (princ))
  (defun draw-mleader (pt1 pt2 strlist Htxt koeff abz / dic mlst i)
  ;;; pt1 - начальная точка UCS
  ;;; pt2 - конечная точка UCS
  ;;; strlist - список строк
  ;;; Htxt - высота текста
  ;;; koeff - коэфф форматирования pxe или nil
  ;;; abz - коэфф форматирования абзаца \\pa или Nil
  ;;;(draw-mleader (setq pt1(getpoint))(getpoint pt1)(list "Пример" "Минскинжпроект" "Третья строка") 1.5 0.9 nil)
 ;;; Стиль мультивыноски текущий
  (setq i 0)
  (command
    "_mleader"
    "_h"
    "_none"
    pt1
    "_none"
    pt2
  (strcat (if koeff (strcat "\\px"
                              (if abz (strcat "a"(VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR abz))",") "")
                              "se" (VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR koeff))";") "")   ;;;"\\pxse0.87;"
;;;            "\\pa0.15;" (car strlist) "\\pa0;"
              (car strlist)
    )
    )
  (while (> (getvar "CMDACTIVE") 0) (command ""))
  (setq dic (vlax-ename->vla-object (entlast)))
  (vla-put-TextString dic
    (strcat (if koeff (strcat "\\px"
                              (if abz (strcat "a"(VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR abz))",") "")
                              "se" (VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR koeff))";") "")   ;;;"\\pxse0.87;"
;;;            "\\pa0.15;" (car strlist) "\\pa0;"
              (car strlist)
;;;              (if abz "\\pa0;" "")
            (apply 'strcat
                   (mapcar '(lambda (x) (strcat "\\P" (if (= (setq i (1+ i)) 1)(if abz "\\pa0;" "")   "")  x)) (cdr strlist))
            ) ;_ end of apply
    ) ;_ end of strcat
  )
    (vla-put-TextHeight dic Htxt)
    dic
  )
  (defun mip-conv-to-str (dat)
      (cond ((= (type dat) 'INT) (setq dat (itoa dat)))
            ((= (type dat) 'REAL) (setq dat (rtos dat 2 12)))
            ((null dat) (setq dat ""))
            (t (setq dat (vl-princ-to-string dat)))
      ) ;_ end of cond
    ) ;_ end of defun
(princ "\nНаберите в командной строке DSTS")

Другие варианты здесь (форум www.caduser.ru) Отмерить по линии расстояние и поставить точку, Прошу помощи у Вас!

skkkk · 06.12.2010, 19:08

VVA, а можно отдельно фрагмент этого кода, который просто спросит точку на кривой, а затем выдаст переменную со значением длины, чтоб я мог использовать этот фрагмент в своем коде #10? Плюс если можно, фрагмент, который даст мне переменную с именем слоя выбранной полилинии. Вообще, можно ли так смешивать командный метод с vl?

Странно....не смог найти переменную dsl

VVA · 06.12.2010, 19:21

Код:

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

(defun polydist (/ adoc *error* crvs eps dL pts pt1 pt2 ptc n osm vx p1 p2 ret)
  
;;;http://forum.dwg.ru/showthread.php?t=8713
;;; Ф-ция возвращает список вида  (расстояние_до_точки_полилинии имя_слоя) или nil
;;; Пример использования
;;;; (if (setq tmp (polydist))(alert (strcat "Длина полилинии до точки:\n" (rtos (car tmp) 2 3) "\nСлой : "(cadr tmp))))
  (defun *error* (msg)(princ msg)(vl-cmdf "_redrawall")(vla-EndUndoMark adoc)
    (setvar "OSMODE" osm))
  (defun dr_st (pt ang color / pt1 pt2)
    (setq pt1 (polar pt (+ ang 2.35619) (* 0.03 (getvar "VIEWSIZE"))))
    (setq pt2 (polar pt (+ ang 3.92699) (* 0.03 (getvar "VIEWSIZE"))))
    (grvecs (list color pt1 pt pt pt2)))
  (defun dr_kr (pt color / pt11 pt12 pt21 pt22 len)
    (setq len  (* 0.02 (getvar "VIEWSIZE"))
	  pt11 (polar pt 3.92699 len)
	  pt12 (polar pt 0.785398 len)
	  pt21 (polar pt 5.49779 len)
	  pt22 (polar pt 2.35619 len))
    (grvecs (list color pt11 pt12 pt21 pt22)))
(defun getblg ( pl / blglist i n ent_data tmp_ent)
(setq ent_data (entget pl))
(cond ((= (cdr(assoc 0 ent_data)) "LWPOLYLINE")
  (setq  blglist (mapcar 'cdr (vl-remove-if-not(function(lambda(x)(= 42(car x)))) ent_data))))
(t (setq tmp_ent pl)
 (while (/= "SEQEND"  (cdr(assoc 0 (entget(setq tmp_ent (entnext tmp_ent))))))
  (setq  blglist (append blglist (list (cdr(assoc 42 (entget tmp_ent)))))))))
   blglist)
  (vl-load-com)(setq osm (getvar "OSMODE"))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-StartUndoMark adoc)
  (setvar "CMDECHO" 0)(setvar "OSMODE" 512)
  (setq pt (getpoint "\nУкажите точку на кривой <выход> : "))
  (if (setq ss (if pt
		 (ssget pt '((0 . "*LINE,ARC")))
		 nil)
      )
    (progn
      (setq en	(ssname ss 0)
	    crv	(vlax-ename->vla-object en)
	    pt	(vlax-curve-getclosestpointto crv (trans pt 1 0))
	    ds	(vlax-curve-getDistAtParam crv (vlax-curve-getEndParam crv)))
      (cond ((= (vla-get-ObjectName crv) "AcDbLine")
	     (setq ds1 (distance (cdr(assoc 10 (entget en))) pt)))
	    ((or (= (vla-get-ObjectName crv) "AcDb3dPolyline")
                 (and
                     (= (vla-get-ObjectName crv) "AcDb2dPolyline")
                     (/= (logand (cdr(assoc 70 (entget en))) 2) 2) ;_Fit
                     (/= (logand (cdr(assoc 70 (entget en))) 4) 4) ;_Spline
                     (vl-every 'zerop (getblg en))
                     )
                 (and
                     (= (vla-get-ObjectName crv) "AcDbPolyline")
                     (vl-every 'zerop (getblg en))
                     )
                 )
	     (setq vx ((lambda ( / i lst)(while (<= (setq i (if i (1+ i) 0))(vlax-curve-getEndParam crv))
                       (setq lst (append lst (list (vlax-curve-getPointAtParam crv i))))) lst)))
	     (setq p1 (car vx) vx (cdr vx) ds1 0)
	     (while (and (setq p2 (car vx))
			 (not (equal (+ (distance Pt P1) (distance Pt P2)) (distance P1 P2) 0.00001))
			 )
	       (setq vx (cdr vx) ds1 (+ ds1 (distance P1 P2)) p1 p2)
	       )
	       (setq ds1 (+ ds1 (distance P1 Pt))))
	    (t (setq  ds1 (vlax-curve-getDistAtParam
			    crv (vlax-curve-getParamAtPoint crv pt)))))
      (dr_st (trans pt 0 1)
	     (angle (trans pt 0 1)
		    (trans (vlax-curve-getPointAtParam crv
			(+ (vlax-curve-getParamAtDist crv ds1) 0.0001))
		      0  1)) 1)
      (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 1)
      (initget "Поменять Change _C C")
      (princ "\nДлинна объекта ")(princ ds1)
      (princ " [Поменять начало] <готово>:")(setq en (getkword))
      (if (= en "C")
	(progn (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 0)
	       (dr_kr (trans (vlax-curve-getEndPoint crv) 0 1) 1)
	       (setq ds1 (- ds ds1))
	)
      )
      (setq ret (list ds1  (vla-get-layer crv)))
)
    )
  (vl-cmdf "_redrawall")
  ret
  )

skkkk · 06.12.2010, 20:31

Спасибо, VVA, то, что надо. Осталось три вопроса(пока):
1) Как сделать разделителем в (rtos (car tmp) 2 3) запятую?
2) Как из названия слоя (cadr tmp) отсечь первые n символов?
Offtop: 3) Какая функция (если она есть) округляет число до целого меньшего

Кулик Алексей aka kpblc · 06.12.2010, 23:14

1) (vl-string-subst "," "." (rtos (car tmp) 2 3))
2) substr
3) fix

skkkk · 09.12.2010, 12:47

А возможно ли то же самое (#11), только в "двойном" виде, то есть если я выбираю точку пересечения (в частности, Т-образного) двух полилиний, и получаю две пары переменных:

Код:

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

(расстояние_до_точки_полилинии1 имя_слоя1)
(расстояние_до_точки_полилинии2 имя_слоя2)

DmAK · 13.06.2012, 23:40

День добрый, VVA! Можно Вас попросить изменить в коде DSTS (#11) вывод длины? 1) без имени слоя, 2)Формат вывода значения - Пикет: например число (длину) 1568,79 чтоб выводил в формате
ПК 15+68,79.

skkkk · 16.06.2012, 13:56

DmAK,

Цитата:

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

в коде DSTS (#11)

надо найти строки

Код:

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

(list
           (strcat "Имя слоя " (vla-get-layer crv)) ;_1-я строка
           (strcat "Длина " (rtos ds1 2 3))  ;_2-я строка длина до 3 знаков после запятой
)

и заменить их на

Код:

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

(list
    (strcat "ПК" (rtos (atoi (rtos (/ ds1 100) 2 2)) 2 0) "+" (vl-string-subst "," "." (rtos (rem ds1 100) 2 2))) ;_1-я строка, длина до 2 знаков после запятой
)

AlGeMix · 14.08.2014, 01:00

Добрый день. Люди, прошу у вас помощи! Какие изменения надо внести в код DSTS, чтобы 1) выводимое значение было в 2 раза меньше (масштаб чертежа 1:500); 2) выводимое значение округлялось до 0.5?

trir · 14.08.2014, 04:50

В AutoCAD'е должен быть масштаб 1:1!

20.10.2006, 15:53		#1
Расстояние от начала полилинии до опеделенной точки bimari проектирование дорог Riga Регистрация: 18.10.2006 Сообщений: 25 Подскажите, пожалуйста как в 2006 акаде можно было определить расстояние от начала полилинии до любой ее точки. Было бы хорошо, если бы кликнув на эту точку появлялся Leader с расстоянием. Заранее спасибо!
Просмотров: 19623