Ушла программа вместе с лиспами!

Ушла программа вместе с лиспами! · 02.12.2006, 00:30

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

Заставьте за себя Б-га молить!

KAI · 02.12.2006, 01:28

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

Profan · 02.12.2006, 20:13

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

Код:

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

(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 · 03.12.2006, 13:19

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

Код:

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

(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 · 03.12.2006, 16:28

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

fixo · 03.12.2006, 19:08

Цитата:

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

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

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

Вдобавок заказчик еще не высказал ничего по поводу...

~'J'~

Profan · 03.12.2006, 20:13

Для Fatty.

Цитата:

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

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

Код:

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

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

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

Роб Рой · 03.12.2006, 23:16

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

Роб Рой · 03.12.2006, 23:38

Цитата:

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

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

Это именно то

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

Profan · 04.12.2006, 02:31

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

Код:

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

(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 · 04.12.2006, 11:37

Цитата:

Сообщение от Роб Рой

Цитата:

Сообщение от 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'~

Роб Рой · 04.12.2006, 20:03

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

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

А насчет того,что вставлять текст или нет - сразу недоглядел:в стороне печатается результат замера.Так что,всё класс,никаких претензий

[sm505]

Роб Рой · 04.12.2006, 20:31

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

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

fixo · 04.12.2006, 21:51

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

Код:

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

;============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 · 04.12.2006, 23:04

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

~'J'~

Profan · 05.12.2006, 06:39

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

Роб Рой · 05.12.2006, 23:09

Цитата:

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

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

Согласен,нет проблем,просто тема многосерийная

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

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

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

Роб Рой · 05.12.2006, 23:17

Цитата:

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

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

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

VVA · 06.12.2006, 09:45

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

Роб Рой · 06.12.2006, 23:44

Цитата:

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

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

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

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

И давай на-ТЫ

fixo · 07.12.2006, 00:19

Как все запущено...
Если после (defun стоит C: (с двоеточием) то это
команда, если не стоит, то это функция
Забавное словосочетание, не находишь?

То что стоит после С: и есть имя команды

Для моей последней рутины:

Загружаешь лисп, в командной строке набери RB
в любом регистре, щелкай по сегментам, для выхода
из цикла нажми Enter
Смотри подсказки в командной строке

Успехов

~'J'~

Роб Рой · 08.12.2006, 00:09

Цитата:

"Fatty"
Смотри подсказки в командной строке

Вот куда он меня послал:
Command: rb
error: null function*Cancel*

Sorry :?

fixo · 08.12.2006, 00:32

Цитата:

Сообщение от Роб Рой

Цитата:

"Fatty"
Смотри подсказки в командной строке

Вот куда он меня послал:
Command: rb
error: null function*Cancel*

Sorry :?

Не надо ля-ля
Только что скопировал свой собственный код отсюда
и все работает как часы
Проверено:
AutoCAD 2005 Windows XP HE

>'J'<

Роб Рой · 08.12.2006, 10:27

Цитата:

"Fatty"
Не надо ля-ля
Проверено:
AutoCAD 2005 Windows XP HE

А я-то на 14-м проверял...Придется сносить на заслуженный отдых

Мои извинения 8)

Роб Рой · 11.12.2006, 19:52

Fatty!
Полный шик-блеск и иммер элегант,как говорили в Черноморске

Действительно дело было в Акаде-14.
Ещё раз sorry

У меня на работе хоть и Windows-XP Professional :wink:,на русском не "понимает",а сам добавить не могу-будут лишние вопросы от Админа.Так что та ссылка на комманды для полилиний мне не помогла :cry: Идет сплошная абракадабра

А как насчёт

Цитата:

Прошу помочь со справками:возможность определения с одного клика длины прямого участка полилинии

Есть надежда :shock: :?:

fixo · 11.12.2006, 20:23

Насчет:

Цитата:

>Прошу помочь со справками:возможность определения с одного >клика длины прямого участка полилинии

даже очень просто, как освобожусь напишу.
Если, конечно, кто раньше не поможет, здесь и покрепче меня много
хлопцев

~'J'~

fixo · 11.12.2006, 21:28

Попробуй в работе, переделай под себя

Код:

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

(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 C:SGL (/ dis ent fpar pickpt spar pline curpt)
      (while
	(setq ent
	       (entsel
		 "\nPick segment point to be dimensioned (or press Enter to exit loop) : "
	       )
	)
	 (setq vobj (vlax-ename->vla-object (car ent)))
	 (setq pickpt (trans (cadr ent) 1 0))
	 (setq curpt (vlax-curve-getclosestpointto vobj pickpt))
	 (setq fpar (1+ (fix (vlax-curve-getparamatpoint vobj curpt)))
	       spar (1- fpar)
	 )
	 (setq dis (distance
		     (vlax-curve-getpointatparam vobj fpar)
		     (vlax-curve-getpointatparam vobj spar)
		   )
	 )
	 (alert	(strcat	"Segment length is: "
			(rtos dis 2 5)
			" metric dwg units or "
			(rtos dis 4 5)
			" imperic dwg units"
		)
	 )
      )
      (princ)
    )

В командной строке вызов естественно: SGL в любом регистре

Be good to your boss

~'J'~

VVA · 12.12.2006, 11:51

С более подробной информацией о сегменте

Код:

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

(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 lib:pline-get-radii  (p1 p2 bulge) 
 (if (not(zerop bulge))    
  (abs (/ (/ (distance p1 p2) 2.0) 
    (sin (* 2.0 (atan bulge))))) 0.0)) 
(defun lib:pline-get-segm-center  (pline p1 p2 bulge / cpt midc midp rad) 
(setq rad (lib:pline-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.0))) p1 p2) 
      cpt (trans (polar midp (angle midp midc) rad) 0 1)) cpt) 
(defun lib:massoc (key alist) 
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist))) 
(defun getblg ( pl / blglist i n ent_data tmp_ent) 
   (if (= (type pl) 'VLA-OBJECT)(setq pl (vlax-vla-object->ename pl))) 
   (setq ent_data (entget pl)) 
  (cond ((= (dxf 0 pl) "LWPOLYLINE") 
    (setq  blglist (lib:massoc 42 ent_data))) 
   (t (setq tmp_ent pl) 
    (while (/= "SEQEND" (dxf 0 (setq tmp_ent (entnext tmp_ent)))) 
      (setq  blglist (append blglist (list (dxf 42 tmp_ent)))));_while 
    )) blglist) 
(defun get-vexs   (pline_obj / verts) 
  (setq verts (vlax-get pline_obj 'Coordinates) 
   verts (cond 
      ((wcmatch (vlax-get pline_obj 'Objectname) "*dPolyline") 
       (group-by-num verts 3)) 
      ((eq (vlax-get pline_obj 'Objectname) "AcDbPolyline") 
       (group-by-num verts 2)) 
      (T nil)))) 
(defun C:SGL ( / dis ent fpar pickpt spar pline curpt blglist blg rad cen p1 p2 str) 
(vl-load-com) 
 (while (setq ent (entsel 
       "\nPick segment point to be dimensioned (or press Enter to exit loop) : "))
(setq vobj (vlax-ename->vla-object (car ent))) 
(setq pickpt (trans (cadr ent) 1 0)) 
(setq curpt (vlax-curve-getclosestpointto vobj pickpt)) 
(setq fpar (1+ (fix (vlax-curve-getparamatpoint vobj curpt))) 
      spar (1- fpar)) 
(setq dis (distance 
   (setq p2 (vlax-curve-getpointatparam vobj fpar)) 
   (setq p1 (vlax-curve-getpointatparam vobj spar)))) 
(setq blglist (getblg (car ent)) blg (nth spar blglist)) 
(setq rad (lib:pline-get-radii p1 p2 blg)) 
(setq cen (lib:pline-get-segm-center vobj p1 p2 blg)) 
(princ "\n\n**** Segment info: ****\n") 
(setq str (strcat "Segment number : " (VL-PRINC-TO-STRING fpar) 
"\nSegment length is: " (rtos dis 2 5) " metric dwg units" 
"\nRadius: "  (rtos rad 2 5) 
"\nSegment center point in WCS: "(VL-PRINC-TO-STRING cen) 
"\nSegment start point in WCS: "(VL-PRINC-TO-STRING p1) 
"\nSegment end point in WCS: "(VL-PRINC-TO-STRING p2))) 
(princ str)(alert str))(princ))
(princ "\nType SGL in command line")

===== Добавлено ===========
Исправлена синтаксическая ошибка (пост № 30)

fixo · 12.12.2006, 13:02

Великолепно

~'J'~

Profan · 12.12.2006, 13:23

Для VVA.
AutoCAD сообщает о синтаксической ошибке в программе. AutoCAD 2007 РУС.

Кулик Алексей aka kpblc · 12.12.2006, 13:25

В последних 2 строчках, похоже, лишняя скобка:

Код:

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

(princ str)(alert str)(princ))
(princ "\nType SGL in command line")

Вроде надо так.

VVA · 12.12.2006, 14:22

Исправил код в №28

Роб Рой · 16.12.2006, 23:47

Ура,заработало 8)
Спасибо всем спасателям за помощь,все бывшие утопленники передают наилучшие пожелания в Новом Году

Пусть жизнь вам кажется мёдом [img]sm/sm511.gif[/img]

Цитата:

Be good to your boss

100%,хоть он пока об этом не знает :wink:

Осталась последняя просьба,думаю,самая сложная

Но это уже в новой теме и немного позже - нужно подготовиться :?

Vova · Регистрация: 05.09.2003

Цитата:

Сообщение от Роб Рой

Недавно хозяину моей фирмы,проектирующей дороги,прошло в голову,что программа по проектированию этих самых дорог стала слишком дорогОй и он её поменял на другую.И это ещё не самое неприятное :evil: Хуже всего то,что с ней "уплыли" и десятки лиспов к Акаду.

А где они хранились? Неужели в одной из папок той программы? Или хозяин ручками все удалял?

Аshаs-ка · 17.12.2006, 09:40

Черт, я вот все примочки- замирочки в Express валю... наверное, дурной тон, или ВОТ ПРИДЕТ ЗЛОЙ НАЧАЛЬНИК!... Правда, копии всего есть.

Роб Рой · 19.12.2006, 00:30

Цитата:

VOVA
А где они хранились? Неужели в одной из папок той программы? Или хозяин ручками все удалял?

Всё до смешного просто:истёк срок годности , а за продолжение хозяин не заплатил...А просто напрямую ,как аппликацию,Акад ни один лисп не берёт :twisted:

Кстати, лиспы все, то-ли закодированы, то-ли на редакторе типа борланда нужно открывать - абракадабра сплошная!
если кто заинтересуется выложить нет проблем.

Кулик Алексей aka kpblc · 19.12.2006, 14:48

Скорее всего, лиспы компилированы (если у них расширение fas или vlx). Их вскрывать бессмысленно - только если с ассемблером не на "ты". А вот если они имебт расширение Lsp, то раскодировать можно. Выложи парочку, может, чего и срастется

Роб Рой · 19.12.2006, 23:51

А файлы-то *.lsp

Собственно,это и есть последняя просьба.Нужно получить координатную рамкус координатной сеткой в определённом масштабе.
Путь был такой:
-сначала в Акаде создаются рамки viewport-ов в Model Space или closed pline или rectangle.
-при помощи RCTNGL.LSP выбирается нижняя сторона (правой кн. мышки по очереди "зажигается" каждая из сторон).
-при помощи IDFRAME.LSP выбираются одна или несколько рамок,
задаётся масштаб и по-большому счёту всё :roll:
Забыл про стрелку север-юг!
Если нужно пример из Акада или что-то из файлов-выложу немедленно!

Мужики,если можно раскрутить ТАКОЕ... Нет слов :shock:
[ATTACH]1166561358.zip[/ATTACH]

Роб Рой · 19.12.2006, 23:52

Второй лисп:
[ATTACH]1166561566.zip[/ATTACH]

Кулик Алексей aka kpblc · 20.12.2006, 08:22

В общем, простой шифрованный лисп

Лови вскрытые исходники. В каталоге formatted - отформатированный код; в original - напрямую восстановленный.
Интересно, что скажет автор, если вдруг здесь появится?
[ATTACH]1166592130.rar[/ATTACH]
Я не тестировал код и ничего по его содержимому сказать не могу - просто некогда

Роб Рой · 20.12.2006, 23:27

Цитата:

kpblc
Интересно, что скажет автор, если вдруг здесь появится?

Что-нибудь из непереводимого :twisted:

kpblc, я пробовал загрузить-требует загрузить всё меню,с одним лиспом не хочет работать.Я тут запаковал несколько файлов,может,пригодятся

[ATTACH]1166646368.zip[/ATTACH]

Кулик Алексей aka kpblc · 21.12.2006, 08:50

Ээээ... Парольчик бы на архив узнать было б неплохо... Имею в виду exe-архив, который там унутри - его не распаковать. А пароль ломать - не, у меня машины не хватит на такое. Либо просто прислать распакованное содержимое. У меня не срослось с распаковкой - никто его не берет из моего софтверного зоопарка

---
P.S. На зарегистрированных компах посмотри, что будет возвращено при (getenv "ctq") - там, похоже, пути какие-то должны быть. В общем, скажи, чего там получается

По крайней мере в начале защита строится на проверке этой переменной.
P.P.S. Вскрытый код лиспов приложить?

Роб Рой · 24.12.2006, 23:01

KpbIC, ну и вопросы у тябя

Давай :!:

С

Цитата:

(getenv "ctq")

пока проблемы, ищу у знакомых в других фирмах

Кулик Алексей aka kpblc · 25.12.2006, 09:05

Ну уж извини, как могу... Во вложении - "вскрытые" лиспы. original - без моего форматирования, formatted - с форматированием.
[ATTACH]1167026755.rar[/ATTACH]

Роб Рой · 25.12.2006, 23:16

kpblc,спасибо!
Было напечатано: !ctq и возвращено: nil
Или пустышка,или давай поподробнее,если что-не так :?
С отформатированными лиспами тоже что-то не ладится :cry:
Акад их не узнаёт

Может, можно на их основе соорудить что-то покруче 8) Чтобы работало

:?:

Кулик Алексей aka kpblc · 26.12.2006, 08:54

Не, я имел в виду именно (getenv "ctq"), а не что-то иное. Ладно, бог с ним. Тут дело такое - нашел я софт, который вскрыл пароль на ехе-шник

И не лень было автору каждый lsp шифровать? Попробую привести в удобоваримый вид

Роб Рой · 26.12.2006, 22:43

kpblc! Я знал,что ты СМОЖЕШЬ 8) :!: :!: :!:
А насчёт

Цитата:

И не лень было автору каждый lsp шифровать?

Я сначала с ним пообщался, он всё доступно разобъяснил.
Всё дело в бабках,о какой лени может идти...
Так что, на форум он не заглянет - натура не та :evil:
Правда, программы у него работают ,не глючат

А об уровне программирования судить не мне...

Syrex · 08.01.2007, 01:55

Извиняюсь за небольшое отклонение от темы

Цитата:

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

- нашел я софт, который вскрыл пароль на ехе-шник

И что это за програмка? и еще не моглибы пояснить почему надо знать асемблер для fas или vlx чтото там токо абракадабра какато.

Кулик Алексей aka kpblc · 09.01.2007, 14:57

Софтина - Advanced Archive Password Recovery.
Внутри архива не только lsp, но еще и arx, и dll. Так что вскрытие (и дешифрация) лиспов может оказаться недостаточным

На выходных пробовал посмотреть, но качественно не получилось

Может, сегодня срастется...

Кулик Алексей aka kpblc · 10.01.2007, 11:03

В общем, попробовал я тут вчерась посидеть с лиспами. Честно скажу, самое простое решение - распаковать приложенный архив в какую-нить папку типа c:\idan_\ и этот же путь вколотить в переменные AutoCAD'a

Код:

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

(setenv "ctq" "C:\\idan_")

В крайнем случае можно попробовать

Код:

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

(setenv "ctq" "c:\\idan_\\")

То есть с двойным слешем в конце.
Если не сработает, то я пас, увы

[ATTACH]1168416238.rar[/ATTACH]

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