[Роб Рой]

Из серии "гримасы капитализма".Недавно хозяину моей фирмы,проектирующей дороги,прошло в голову,что программа по проектированию этих самых дорог стала слишком дорогОй и он её поменял на другую.И это ещё не самое неприятное :evil: Хуже всего то,что с ней "уплыли" и десятки лиспов к Акаду. :cry: Стал разбираться сам,как написать хотя-бы жизненно важные,но увы - за пару недель освоить на таком уровне лиспы вряд-ли удасться,а работа не ждёт.Поэтому решил просить помощи у уважаемых знатаков :? Спасёте утопающих?Тонут 5 человек!
Одна из проблем: 2D-Distance.При измерении расстояний на топографических картах,даёт проекцию на плоскость,не реагируя на значения Z.Кроме того,при задании первой точки,автоматом включает привязку nearest.а для второй - perpendicular.Если сможете помочь с этим,с вашего позволения,продолжу
Заставьте за себя Б-га молить!

[KAI]

DISTLAO (http://geol-dh.ru), но правда привязки автоматом не включаются.

[Profan]

Для Роб Рой.
Может, сгодится:

Код:

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

(defun C:2D_DIST ( / osm ent dst)
(setq osm (getvar "OSMODE"))
(setvar "OSMODE" 0)
(princ "\n Укажите две точки для определения расстояния: ")
(command "_LINE" "_nea" pause "_per" pause "")
(setq ent (entget (entlast)))
(command "_ERASE" "_LAST" "")
(setq dst (distance 
          (list (nth 0 (assoc 10 ent)) (nth 1 (assoc 10 ent)))
          (list (nth 0 (assoc 11 ent)) (nth 1 (assoc 11 ent)))
          )
)
(princ "\n Проекция расстояния на плоскость XY = ") (princ dst)
(setvar "OSMODE" osm)
(princ)
)

[fixo]

У меня есть похожая на то что нужно:

Код:

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

(defun c:2d (/ *error* an ans d mp osm p1 p2 pda pt1 pt2)
  
  (defun *Error* (msg) ;error trapp by Joe Bourke
 (cond 
  ((or (not msg) 
       (member msg '("console break" 
                     "Function cancelled" 
                     "quit / exit abort")))) 
  ((princ (strcat "\nError: " msg))) 
 )
 (if osm
 (setvar "osmode" osm)) 
 (setvar "cmdecho" 1)
  (command "_.undo" "e")
 (princ) 
)
  (setvar "cmdecho" 0)
  (command "_.undo" "be") 
  (setq osm (getvar "osmode"))
  (setvar "osmode" 512)
  (setq p1 (getpoint "\nНачальная точка промера >>"))
  (setvar "osmode" 128)
  (setq p2 (getpoint p1 "\nКонечная точка промера >>"))
  (setq pt1 (list (car p1)(cadr p1) 0)
	pt2 (list (car p2)(cadr p2) 0)
	an (angle pt1 pt2)
	d (distance pt1 pt2))
  (setvar "users1" (rtos d 2 5))
  (alert (strcat "Длина промера:\n" (getvar "users1")))
  (initget "Yes No")
  (setq ans (getkword "\nВставить текст? [Y]es or [N]o <N>: "))
  (if (not ans)(setq ans "No"))
  (if (eq  ans "Yes")
    (progn
    (setq mp (mapcar (function (lambda(a b)(* (+ a b) 0.5))) pt1 pt2))
  
    (entmake
      (list
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(100 . "AcDbText")
	'(71 . 0)
        '(72 . 4) 
	'(73 . 0)
        (cons 1 (getvar "users1"))
        (cons 10 mp)
        (cons 11 mp)
        (cons 40 (getvar "dimtxt"))
	(cons 50 an)
	))
    )
    )
  (setvar "osmode" osm)
  (setq osm nil)
  (*error* nil)
  (princ)
  )
(prompt "\n\t***\tПрограмма загружена. Команда для выполнения: 2d или 2D")
(princ)

~'J'~

[Profan]

Для Fatty.
Опять забыли, что программу могут применить пользователи русскоязычных версий AutoCAD? А ведь живете в Славном граде, а не в Гонолулу.
Не мешало бы отобразить "Длину промера" в командной строке, а то Alert убрал с экрана и забыл, что там было записано.
А как тут *error* восстанавливается?

[fixo]

Сообщение от Profan Для Fatty. Опять забыли, что программу могут применить пользователи русскоязычных версий AutoCAD? А ведь живете в Славном граде, а не в Гонолулу. Не мешало бы отобразить "Длину промера" в командной строке, а то Alert убрал с экрана и забыл, что там было записано. А как тут *error* восстанавливается?

Если АвтоКАД не очень древний, обработчик восстанавливается
сам (начиная с 2004 защита от дураков) в строчке (*error* nil)
Мнение не мое, но авторитетное
А насчет русскоязычных версий, увы, такой не имею, а без
проверки на натуре не работаю
Вдобавок заказчик еще не высказал ничего по поводу...

~'J'~

[Profan]

Для Fatty.

обработчик восстанавливается сам (начиная с 2004 защита от дураков) в строчке (*error* nil) Мнение не мое, но авторитетное

Интересно, если так.
Надо бы вот так записать:

Код:

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

....................................
(command "_.undo" "_e")
....................................
(command "_.undo" "_be")

Извини за дотошность.

[Роб Рой]

Для Profan:
пока успел проверить №3. С-виду именно то,что искал:и с Z и с привязками,но...Результат не тот.Посмотри сам.Думал,что дело в Units,но Акад-14 врёт не хуже2007-го.
Очень жаль,но губу придется закатать на место :?

[Роб Рой]

Сообщение от Fatty У меня есть похожая на то что нужно:

Это именно то :!: Дома на 14 версии работает как надо,только предлагает зачем-то вставить текст,когда ставлю "У",выдает
Вставить текст? [Y]es or [N]o <N>: y
Error: null function_.undo Auto/Control/BEgin/End/Mark/Back/<Number>: e
Ну да и Error с ним!Если на работе на 2007-м всё выстрелит,ТО Урра всем вам,Чудо-Богатыри :!:

[Profan]

Для Роб Рой.
Правильный код:

Код:

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

(defun C:2D_DIST ( / osm ent dst) 
(setq osm (getvar "OSMODE")) 
(setvar "OSMODE" 0) 
(princ "\n Укажите две точки для определения расстояния: ") 
(command "_LINE" "_nea" pause "_per" pause "") 
(setq ent (entget (entlast))) 
(command "_ERASE" "_LAST" "") 
(setq dst (distance 
          (list (nth 1 (assoc 10 ent)) (nth 2 (assoc 10 ent)) 0)
          (list (nth 1 (assoc 11 ent)) (nth 2 (assoc 11 ent)) 0)
          ) 
) 
(princ "\n Проекция расстояния на плоскость XY = ") (princ dst) 
(setvar "OSMODE" osm) 
(princ) 
)

Вариант:

Код:

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

(defun C:2D_DIST ( / osm pt1 pt2 dst) 
(setq osm (getvar "OSMODE")) 
(setvar "OSMODE" 0)
(setvar "osmode" 512) 
(setq pt1 (getpoint "\n Первая точка: "))
(setvar "osmode" 128)
(setq pt2 (getpoint pt1 "\n Вторая точка: "))
(setq dst (distance 
          (list (nth 0 pt1) (nth 1 pt1))
          (list (nth 0 pt2) (nth 1 pt2))
          ) 
) 
(princ "\n Проекция расстояния на плоскость XY = ") (princ dst) 
(setvar "OSMODE" osm) 
(princ) 
)

Что-то мне не очень нравится, что не остается следов точек, по которым производилось определение расстояния. Поэтому в моем первом варианте и отрисовывался сначала отрезок, а потом стирался. Но можно и оставить этот отрезок на экране, если закоментарить соответствующую строку, вот так:

Код:

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

;(command "_ERASE" "_LAST" "")

Сам отрезок можно будет потом стереть вручную. К тому же, может быть, окажется полезным знать действительное расстояние в пространстве между данными точками, а его можно узнать через свойства отрезка. Возможен и вариант без программной установки объектных привязок, с заданием их "на лету":

Код:

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

(defun C:DIST_2D ( / pt1 pt2 dst) 
(setq pt1 (getpoint "\n Первая точка: ")) 
(setq pt2 (getpoint pt1 "\n Вторая точка: "))
(setq dst (distance pt1 pt2))
(princ "\n Расстояние между точками в пространстве = ") (princ dst) 
(setq dst (distance 
          (list (nth 0 pt1) (nth 1 pt1)) 
          (list (nth 0 pt2) (nth 1 pt2)) 
          ) 
) 
(princ "\n Проекция расстояния на плоскость XY = ") (princ dst) 
(princ) 
)

[fixo]

Сообщение от Роб Рой Сообщение от Fatty У меня есть похожая на то что нужно: Это именно то :!: Дома на 14 версии работает как надо,только предлагает зачем-то вставить текст,когда ставлю "У",выдает Вставить текст? [Y]es or [N]o <N>: y Error: null function_.undo Auto/Control/BEgin/End/Mark/Back/<Number>: e Ну да и Error с ним!Если на работе на 2007-м всё выстрелит,ТО Урра всем вам,Чудо-Богатыри :!:

Собственно если тебе не надо вставлять текст,
тогда пробуй так, последний замер будет сохранен в переменной
USERS1, просто набери ее в командной строке и она под рукой
Добавил цикл для многократных промеров

Код:

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

(defun c:2d (/ an d osm p1 p2 pt1 pt2)   
  (setvar "cmdecho" 0)
  (setq osm (getvar "osmode"))
  
  (while
  (and (setvar "osmode" 512)
  (setq p1 (getpoint "\nНачальная точка промера [Enter для выхода]>>")))
  (setvar "osmode" 128)
  (setq p2 (getpoint p1 "\nКонечная точка промера >>"))
  (setq pt1 (list (car p1)(cadr p1) 0)
	pt2 (list (car p2)(cadr p2) 0)
	an (angle pt1 pt2)
	d (distance pt1 pt2))
  (setvar "users1" (rtos d 2 5))
  (alert (strcat "Длина промера:\n" (getvar "users1")))) 
  (setvar "osmode" osm) 
  (princ)
  )
(prompt "\n\t*|*\tПрограмма промеров загружена.\t\t*|*\t
\n\t*|*\tКоманда для выполнения: 2d или 2D\t*|*")
(princ)

~'J'~

[Роб Рой]

Для Profan:
Спасибо за доводку!Завтра посмотрю обязательно,очень благодарен за участие

Для Fatty:
Испытания прошли успешно! Всем поставил твой lisp.Народ сразу не поверил- Так вот сразу,и...РАБОТАЕТ :!: :!: :!: Невероятно
А насчет того,что вставлять текст или нет - сразу недоглядел:в стороне печатается результат замера.Так что,всё класс,никаких претензий [sm505]

[Роб Рой]

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

Раз уж пошел разговор о полилиниях :?
Хотелось бы при их реверсе сначала увидеть направление,затем получить вопрос,делать или нет этот самый реверс и, на-закуску, сама команда.На первое время,я нашел выход-сделал из двух лиспов (один показывает направление стрелочками,исчезающими,как блипсы,а другой делает сам реверс) макрос.Он делает реверс,но без лишних вопросов.Так, в случае правильно направленной полилинии, приходится её сначала развернуть,а потом отменять реверс. :cry:
Буду очень признателен за помощь

[fixo]

Небольшой совет:
новый вопрос - новая тема
Так его увидят больше помощников
Для радиусов откопал свою старую рутину,
не помню, чтоб шибко проверял, доверяю тебе

Код:

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

;============code start
;by Fatty 

;;			helper functions	;;
 
;; group list in sublists
 
(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
  );+
 
;get polyline vertices
 
(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)
		  )
)
  );+

;; get bulge radius
;; math by Juergen Menzi
(defun get-radii  (p1 p2 bulge)
  (abs (/ (distance p1 p2) 2 (sin (/ (* 4 (atan (abs bulge))) 2)))));+

;;get segment arc center
;;math by John Uhden
(defun get-segm-center  (pline p1 p2 bulge / cpt midc midp rad)
(setq rad (get-radii p1 p2 bulge)
      midp (vlax-curve-getpointatparam pline
       (+ (fix (vlax-curve-getparamatpoint pline p1)) 0.5))
      midc (mapcar (function (lambda (x y)(/ (+ x y) 2))) p1 p2)
      cpt (trans (polar midp (angle midp midc) rad) 0 1)
)
cpt
);+

;main part
(defun sap (/ bpt bulg cent coors ent ept
	       pln rad segm snap_pt spt)
(vl-load-com)
(setq	pln (vlax-ename->vla-object
	      (car (setq ent (entsel "\n\t>>>\tSelect polyline\t<<<\n")))))

(setq snap_pt (trans (cadr ent) 1 0)
      bpt (vlax-curve-getclosestpointto pln snap_pt))
(if (eq (vla-get-closed pln) :vlax-false)
    (setq coors (get-vexs pln))
    (progn (setq coors (get-vexs pln))
	   (setq coors (append coors (list (car coors))))))
(setq segm (fix (vlax-curve-getparamatpoint pln bpt))
      spt (nth segm coors)
      ept (nth (1+ segm) coors)
      bulg (vla-getbulge pln segm)
      rad (get-radii spt ept  bulg)
      cent (trans (get-segm-center pln spt ept bulg) 1 0))

(if (or
      (not ent)
      (zerop bulg)
      )
    (progn
    (alert "Error. Straight segment selected.")
    nil
    )
    (list rad cent)
  )
);?


; TesT :
(defun C:RB( / *error* lst)
(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)


  (while 

    (setq lst (sap))

    (alert (strcat "Радиус: " (vl-princ-to-string (car lst)) "\n"
	   "Центр:\n" (vl-princ-to-string (cadr lst)))))  
  (*error* nil)
  (princ)
  )
	   
(prompt "\n\t\t***\tType RB to execute\t***")
(princ)
;;;TesT : (C:rb)
;===================code end

~'J'~

[fixo]

Кстати на этом форуме а также конкретно здесь:
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=20450SW
можешь найти то что тебе нужно

~'J'~

[Profan]

Для Роб Рой.
Если вы вплотную занимаетесь полилиниями, то обязательно загляните сюда:
http://dwg.ru/forum/viewtopic.php?t=9627

[Роб Рой]

Сообщение от Fatty Небольшой совет: новый вопрос - новая тема Так его увидят больше помощников

Согласен,нет проблем,просто тема многосерийная
Продублирую вторую часть в новой теме,да простит меня Админ :!:

Спасибо за кривые,буду тестировать :!:

На линк ходил,спасибо [img]sm/sm915.gif[/img] См.выше,я могу делать реверс для полилинии,просто раньше был более удобный алгоритм 8)

[Роб Рой]

Сообщение от Profan Для Роб Рой. Если вы вплотную занимаетесь полилиниями, то обязательно загляните сюда: http://dwg.ru/forum/viewtopic.php?t=9627

Спасибо,Profan,был...У меня p-lines довольно простые:прямая вставка-угол поворота со вписанной кривой-прямая вставка-...и т.д. бывают,правда и клотоиды, но это уже другой разговор.Всё то богатство мне не на чем применить,увы :cry:

[VVA]

Entrevs по ссылке Profan как раз делает все по твоему алгоритму с поста 13

[Роб Рой]

Сообщение от Fatty Для радиусов откопал свою старую рутину, не помню, чтоб шибко проверял, доверяю тебе

К сожалению, тест не смог провести :cry: ,т.к. не нашел имени команды.Обычно я брал его из строки типа:
(defun C:DIST_2D ( / pt1 pt2 dst).

Объясняй уж до конца, будь добр :?доцент тупой :!:

И давай на-ТЫ