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

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

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

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

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]
Я не тестировал код и ничего по его содержимому сказать не могу - просто некогда

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