Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Расстояние от начала полилинии до опеделенной точки

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

Ответ
Поиск в этой теме
Непрочитано 20.10.2006, 15:53
Расстояние от начала полилинии до опеделенной точки
bimari
 
проектирование дорог
 
Riga
Регистрация: 18.10.2006
Сообщений: 25

Подскажите, пожалуйста как в 2006 акаде можно было определить расстояние от начала полилинии до любой ее точки. Было бы хорошо, если бы кликнув на эту точку появлялся Leader с расстоянием. Заранее спасибо!
Просмотров: 18366
 
Непрочитано 14.08.2014, 09:31
#21
AlGeMix


 
Регистрация: 14.08.2014
Сообщений: 4


Это я понимаю. Но и все-таки. Я конечно в этом вопросе нуб, но нельзя ли в программу какое-нибудь "/ 2" добавить?
AlGeMix вне форума  
 
Непрочитано 14.08.2014, 10:51
#22
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Цитата:
Сообщение от AlGeMix Посмотреть сообщение
нельзя ли в программу какое-нибудь "/ 2" добавить?
Можно. Нужно найти строку
Код:
[Выделить все]
(strcat "Длина " (rtos ds1 2 3))
и заменить на
Код:
[Выделить все]
(strcat "Длина " (rtos (/ ds1 2) 2 3))
Но все-таки, действительно чертить нужно в масштабе 1:1. Хотя бы просто потому, что помимо этой проблемы, где программно можно-таки решить, сразу решится много других. Например, при откладывании расстояний не нужно делить на 2, не будет путаницы с коэффициентами-масштабами и проч. Хотя и от специфики работы многое зависит, к примеру, есть чертежи, в которых масштаб по разным осям различен.
По поводу округления до 0.5 нужно уточнить. Оно должно произойти по правилам арифметики? Т.е. 1.2->1.0 (или просто 1); 1.3->1.5; 1.7->1.5; 1.8->2.0. Или в большую сторону? Или еще как-то?
skkkk вне форума  
 
Непрочитано 14.08.2014, 13:08
#23
AlGeMix


 
Регистрация: 14.08.2014
Сообщений: 4


skkkk, спасибо за быстрый ответ. Вы совершенно точно заметили насчет специфики работы. В моем случае она и есть. Округление до 0,5 в ближайшую сторону, как вы и написали. А что касается деления на 2, что заменить в варианте с пикетами из (#11)??
Код:
[Выделить все]
(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, 13:35
#24
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Цитата:
Сообщение от AlGeMix Посмотреть сообщение
Вы совершенно точно заметили насчет специфики работы. В моем случае она и есть.
Offtop: Это случайно не трасса какого-нибудь линейного объекта? С профилем? Дело в том, что я раньше тоже чертил в масштабе 1:2, но теперь признаю: это было моей самой большой ошибкой за все годы работы в Автокаде. Даже чертежи, приходящие от смежников в пятисотке, я теперь перевожу в тысячник (то есть, в масштаб 1:1 - в одном миллиметре один метр) Можно почитать тут.
По теме: нужно вместо ds1 написать (/ ds1 2). Но чтобы в случае, когда значение пикетажа соответствует самому пикету, не выдавалась надпись вида ПК3+0.0, надо строки из #23 заменить на:
Код:
[Выделить все]
(list
    (if (= (rem (/ ds1 2) 100) 0) 
        (strcat "ПК" (rtos (atoi (rtos (/ (/ ds1 2) 100) 2 10)) 2 0))
        (strcat "ПК" (rtos (atoi (rtos (/ (/ ds1 2) 100) 2 10)) 2 0) "+" (vl-string-subst "," "." (rtos (rem (/ ds1 2) 100) 2 1)))
    )
)
Проверить код сейчас нет возможности, поэтому мог ошибиться, но вроде все верно.
Насчет округления смогу посмотреть позже, когда - не знаю - большой завал.
skkkk вне форума  
 
Непрочитано 15.08.2014, 12:59
#25
AlGeMix


 
Регистрация: 14.08.2014
Сообщений: 4


Работает. Еще раз спасибо, очень выручили.

Offtop: Ага, трасса газопровода. Съемка изыскателей в 500-ом масштабе. Съемку мы не масштабируем, в каком масштабе пришла на той и чертим в модели, после выставляя в листах требуемый масштаб видового экрана.
AlGeMix вне форума  
 
Непрочитано 15.08.2014, 13:11
#26
sertor

Геодезист
 
Регистрация: 23.05.2012
Ухта
Сообщений: 1,374


Цитата:
Сообщение от AlGeMix Посмотреть сообщение
Съемка изыскателей в 500-ом масштабе. Съемку мы не масштабируем, в каком масштабе пришла на той и чертим в модели, после выставляя в листах требуемый масштаб видового экрана
Практически во всех геодезических программах экспорт в dxf/dwg по умолчанию выполняется в масштабе 1:1000 (пространство модели).
__________________
Как-то так.
sertor вне форума  
 
Непрочитано 23.12.2014, 12:44
#27
alex101000


 
Регистрация: 23.11.2011
Сообщений: 175


Уважаемые, может помочь в доработке ? Требуется получить общую длину сегментов между двумя точками на полилинии, не от начала. Между двумя указанными точками на полилинии может быть N узлов.
alex101000 вне форума  
 
Непрочитано 25.12.2014, 15:21
#28
alex101000


 
Регистрация: 23.11.2011
Сообщений: 175


Коряво, но работает:

Код:
[Выделить все]
 
(defun C:vert (/ ln1 ln2 lll)
	(setq ln1 (polydist))
	(setq ln2 (polydist))
	(if (< ln1 ln2) 
		(setq lll (- ln2 ln1)) 
		(setq lll (- ln1 ln2))
	)
      (strcat "Длина: " (vl-string-translate "." "," (rtos lll 2 4)))
)

(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)
  (setvar "CMDECHO" 0)(setvar "OSMODE" 33)
  (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)))
;XL
;
      (setq ret ds1)
)
    )
  (vl-cmdf "_redrawall")
  ret
  )
alex101000 вне форума  
 
Непрочитано 25.12.2014, 15:34
#29
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Зачем так сложно? Можно значительно быстрее и проще!
Код:
[Выделить все]
 (vl-load-com)

(defun tt (/ ent pt1 pt2)
  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (car (entsel "\nSelect Line, Spline or Polyline <Cancel> : "))
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (wcmatch (strcase (cdr (assoc 0 (entget ent)))) "*LINE")
           (setq ent (vlax-ename->vla-object ent))
           (= (type (setq pt1 (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (getpoint "\nSelect first point <Cancel> : ")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           pt1
           (= (type (setq pt2 (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (getpoint "\nSelect second point <Cancel> : ")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           pt2
           ) ;_ end of and
    (princ (strcat "\nDistance = "
                   (rtos (abs (- (vlax-curve-getdistatpoint ent (vlax-curve-getclosestpointto ent pt1))
                                 (vlax-curve-getdistatpoint ent (vlax-curve-getclosestpointto ent pt2))
                                 ) ;_ end of -
                              ) ;_ end of abs
                         2
                         (getvar "luprec")
                         ) ;_ end of rtos
                   ) ;_ end of strcat
           ) ;_ end of princ
    ) ;_ end of if
  (princ)
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 25.12.2014, 15:47
#30
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Offtop: Эх, Алексей, где ж ты был пару дней назад?
Человек по ходу два дня сидел разбирался, осилил, понял где и что нужно поменять (хоть я код и не тестил, но уважение вызывает), а ты ему мол, можно проще и быстрее. За десять минут ему решение родил, вроде как когда уже и не надо.
alex101000, в жизни пригодится
skkkk вне форума  
 
Непрочитано 25.12.2014, 15:54
#31
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


skkkk, пару дней назад я занимался другой работой.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 25.06.2019, 09:52
#32
Lumpy


 
Регистрация: 25.06.2019
Сообщений: 13


а возможно ли сделать так чтобы результат записывался в атрибут блока??
Lumpy вне форума  
 
Непрочитано 25.06.2019, 10:05
#33
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от Lumpy Посмотреть сообщение
а возможно ли сделать так чтобы результат записывался в атрибут блока??
Заменяете последний непустой вывод princ на присвоение значения переменной и потом значение этой переменной можете задавать любому выбранному объекту с поддержкой текста.
Сергей812 вне форума  
 
Непрочитано 25.06.2019, 17:09
#34
Lumpy


 
Регистрация: 25.06.2019
Сообщений: 13


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Заменяете последний непустой вывод princ на присвоение значения переменной и потом значение этой переменной можете задавать любому выбранному объекту с поддержкой текста.
спасибо.
а если не сложно предоставить пример функции присвоения значения перемеренной выбранному объекту.
Lumpy вне форума  
 
Непрочитано 26.06.2019, 17:57
#35
Lumpy


 
Регистрация: 25.06.2019
Сообщений: 13


помогите сделать так чтобы текст записывался не мультивыноской, а шел в атрибут блока. кодер из меня никакой (проектировщик). по отдельности рабочее получилось сделать, а чтоб в одной команде никак =(

Код:
[Выделить все]
  (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
           (if (= (rem ds1 1000) 0) 
        (strcat "КМ" (rtos (atoi (rtos (/ ds1 1000) 2 10)) 2 0))
        (strcat "КМ" (rtos (atoi (rtos (/ ds1 1000) 2 10)) 2 0) "+" (vl-string-subst "," "." (rtos (rem ds1 1000) 2 1)))
    )
           )
          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")
Lumpy вне форума  
 
Непрочитано 06.07.2019, 08:48
#36
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Lumpy, для проектировщика ТЗ могло бы быть более обширным.
Если всё правильно понял, то вот (без проверки на пустой клик, т.е, если попасть куда-либо мимо атрибута, то будут ошибки). Но поскольку ТЗ - хз, то и обработчик ошибок еще рановато делать. Да, и атрибут при этом должен быть многострочным, иначе, результат не очень порадует. Разумеется, как готовая программа использоваться не может. Прототип, типа.

Код:
[Выделить все]
   (defun C:DST2ATR (/ adoc *error* crvs eps dL pts pt1 pt2 ptc n osm vx p1 p2 str attr)
;;;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))
		)
      )
      )
    )
	(setq str 
		(strcat 
			"КМ" (rtos (atoi (rtos (/ ds1 1000) 2 10)) 2 0) "\n"
			"КМ" (rtos (atoi (rtos (/ ds1 1000) 2 10)) 2 0) "+" (vl-string-subst "," "." (rtos (rem ds1 1000) 2 1))
		)
	)
	(setq attr (car (nentsel "\nВыберите атрибут блока: ")))
	(if  attr
		(vla-put-TextString (vlax-ename->vla-object attr) str)
	
	
	
	)
  (setvar "OSMODE" osm)
  (vla-EndUndoMark adoc)
  (vl-cmdf "_redrawall")
  (princ))
	(princ "\nНаберите в командной строке DST2ATR")(princ)

Последний раз редактировалось skkkk, 07.07.2019 в 01:25.
skkkk вне форума  
 
Непрочитано 08.07.2019, 09:18
#37
Lumpy


 
Регистрация: 25.06.2019
Сообщений: 13


Цитата:
Сообщение от skkkk Посмотреть сообщение
Lumpy, для проектировщика ТЗ могло бы быть более обширным.
Если всё правильно понял, то вот (без проверки на пустой клик, т.е, если попасть куда-либо мимо атрибута, то будут ошибки). Но поскольку ТЗ - хз, то и обработчик ошибок еще рановато делать. Да, и атрибут при этом должен быть многострочным, иначе, результат не очень порадует. Разумеется, как готовая программа использоваться не может. Прототип, типа.

Код:
[Выделить все]
   (defun C:DST2ATR (/ adoc *error* crvs eps dL pts pt1 pt2 ptc n osm vx p1 p2 str attr)
;;;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))
		)
      )
      )
    )
	(setq str 
		(strcat 
			"КМ" (rtos (atoi (rtos (/ ds1 1000) 2 10)) 2 0) "\n"
			"КМ" (rtos (atoi (rtos (/ ds1 1000) 2 10)) 2 0) "+" (vl-string-subst "," "." (rtos (rem ds1 1000) 2 1))
		)
	)
	(setq attr (car (nentsel "\nВыберите атрибут блока: ")))
	(if  attr
		(vla-put-TextString (vlax-ename->vla-object attr) str)
	
	
	
	)
  (setvar "OSMODE" osm)
  (vla-EndUndoMark adoc)
  (vl-cmdf "_redrawall")
  (princ))
	(princ "\nНаберите в командной строке DST2ATR")(princ)
Огромнейшее спасибо все работает как нужно.
Lumpy вне форума  
 
Непрочитано 15.11.2020, 14:15
#38
Blik91


 
Регистрация: 15.11.2020
Сообщений: 5


Цитата:
Сообщение от Lumpy Посмотреть сообщение
Огромнейшее спасибо все работает как нужно.
Поделитесь окончательным вариантом лиспа?
Попробовал запустить, пишет:
Рекомендуется преобразовать (command) в (command-s)

Нашел, что ошибка из-за кода для версий до 2015 года. Может у вас есть для современных версий?
Blik91 вне форума  
 
Непрочитано 15.11.2020, 19:45
#39
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Blik91, о каком лиспе речь?
skkkk вне форума  
 
Непрочитано 15.11.2020, 20:28
#40
Blik91


 
Регистрация: 15.11.2020
Сообщений: 5


Цитата:
Сообщение от skkkk Посмотреть сообщение
Blik91, о каком лиспе речь?
Предыдущий пост #37.
Blik91 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Расстояние от начала полилинии до опеделенной точки

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск