[dextron3]

Хотел поинтересоваться есть ли лисп который бы мог выполнять следующие функции, рисует две параллельно линии и при повороте должны скругляться по радиусу зависимому от расстояние от этих линий, нужен для рисования дорог на генплане, если уже есть такие разработки просьба показать...


заранее благодарен

[Дима_]

А стандартную мутьлтилинию не смотрел?

[Кулик Алексей aka kpblc]

Мультилиния не поддерживает дуговые сегменты, насколько я помню.

[zenon]

Сообщение от dextron3 Хотел поинтересоваться есть ли лисп который бы мог выполнять следующие функции, рисует две параллельно линии и при повороте должны скругляться по радиусу зависимому от расстояние от этих линий, нужен для рисования дорог на генплане, если уже есть такие разработки просьба показать... заранее благодарен

Рисуешь осевую и offset/
ps где то даже была программка для прорисовки в обе стороны

[Nike]

Где-то в AutoCAd вроде есть динамические блоки для отрисовки дорог с полосами движения - перекресток, поворот, участок дороги, что-то такое...

[Дима_]

Сообщение от Кулик Алексей aka kpblc Мультилиния не поддерживает дуговые сегменты, насколько я помню.

Верно но что-то типа нарисовал, взорвал, полилиния, сопряжение (можно в принципе и в макрос загнать).

[Кулик Алексей aka kpblc]

Может, проще воспользоваться готовым решением?
http://www.google.ru/custom?hl=ru&in...%3Azeqjjx-kn0v

[VVA]

посмотри здесь
1. LISP. Отрисовка произвольной трассы из отрезков и дуг.
2. LISP. Подобие в обе стороны(Смотреть команды OFF2 и MOFF2)

Код программы

4. Исправленую версию Exfillet

[dextron3]

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

А то получается для того чтобы нарисовать переулок я сначало его ось рисую с углами потом эти углы скругляю а потом офсечу и соединяю, как бы эту рутину автоматизировать, я теперь понял почему генпланами только бабушки увлекаются...

[ShaggyDoc]

Разумеется, такие программы есть у меня. Для рисования всех видов дорог, они с разными обозначениями. Широко используются в топографии.

А вот для рисования генпланов они не нужны. Я имею ввиду генпланы и дороги, вычерчиваемые настоящими генпланистами.

Там важнее не параллельность бровок (это сделать проще всего), а радиусы кривых, сопряжения осей, радиусы и центры сопряжений бровок на перекрестках. Это все весьма индивидуально и разнообразно. Здесь более удобны именно штатные команды Автокада для геометрических построений. Ими и пользуются, даже при наличии программ рисования дорог. А вот когда надо нарисовать километры лесных, полевых и прочих дорог без задания радиусов, а "по факту" - тогда и пользуются дополнительными программами.

[dextron3]

ShaggyDoc, вот я и хотел автоматизировтаь деятельность, тротуаров вообще очень много, и на каждый время терять не хотелось бы, и острые углы тоже не вариант...

[Рyslan]

ShaggyDoc, когда ruCAD то выйдет? дали бы попользоваться новой демо-версией, хотя бы на месяц. интересно же

[Profan]

dextron3 , попробуй такой код:

Код:

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

;;;********** SETI.LSP *********************************** 
;;; Программа отрисовки сети из сопряженных отрезков. 
;;; Автор Владимир Громов (Profan) 2009 г. 
;;;-------------------------------------------
;;; Корректировка для опции Отмени (UNDO)
;;; 20.02.2009 Восстановление переменных, отмена команды за 1 раз.
;;; Владимир Азарко (VVA) 
;;;-------------------------------------------
;;; 22.02.2009
;;; Добавлена простановка длин линейных сегментов на непечатаемом слое
;;; текущим текстовым стилем.
;;; Владимир Громов (Profan)
;;;-------------------------------------------
;;; Макрос для загрузки: 
;;; ^C^C(if (not C:СЕТИ)(load "seti"));СЕТИ; 
;;; ^C^C(if (not C:СЕТИ_ПЛ)(load "seti"));СЕТИ_ПЛ; 
;;; 

(defun C:СЕТИ_ПЛ ()(seti t)) 
(defun C:СЕТИ ()(seti nil)) 
(defun seti ( toPline / rd pt1 pt2 ent1 ent2 U_M *error* eLast ss usr_list
                        lay dlina ugol lay_dlina kod40) 
;;;Функция seti - отрисовка сетей 
;;; Аргумент toPline = t - собирать в полилинию 
;;;          toPline = nil - нет 
  (vl-load-com) 
  ;;;Объявляем локальную ф-цию *error* 
  (defun *error* (msg / image_set kod40) 
;;;Прерываем активную команду   
(while (> (getvar "CMDACTIVE") 0)(command)) 
;(princ msg) 
(princ "\n *Работа программы отменена пользователем.*")
(setq kod40 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
      (if (= kod40 0)
      (vl-cmdf "_TEXT" "0,0" "" "0" "1")
      (vl-cmdf "_TEXT" "0,0" "0" "1")
      )
(entdel (entlast))
(mapcar '(lambda(x)(setvar (car x)(cdr x))) usr_list)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))    
(princ) 
  )
;;;Проверяем установки UNDO и устанавливает All control 
  (setq U_M (getvar "UNDOCTL")) 
  (cond 
    ((= (logand U_M 1) 0)(command "_.UNDO" "_All"))  ;;; Отключено UNDO 
    ((= (logand U_M 3) 3)(command "_.UNDO" "_Control" "_All")) ;;; Разрешена отмена одной операции 
    (t nil) 
  ) ;_ end of cond
(setq usr_list  (mapcar '(lambda(x)(cons x (getvar x))) '("USERR1" "USERR2" "USERS1" "USERS2" 
"CLAYER" "CMDECHO")))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
;(setq U_M (getvar "UNDOMARKS")) ;;;VVA Запоминаем счетчик отмен UNDO
(setq U_M 0) ;;;VVA Устанавливаем счетчик отмен UNDO  
(setvar "USERS1" "")  ;;;Чистим переменные 
(setvar "USERS2" "")  ;;;Чистим переменные 
(setvar "CMDECHO" 0) 
(if toPline   
;;; Запоминаем в eLast последний примитив 
(if (null(setq eLast (entlast))) 
    (progn (entmake '((0 . "point") (10 0.0 0.0 0.0))) 
       (setq eLast (entlast))(entdel eLast))) 
  ) 
(princ " Текущий радиус сопряжения = ") (princ (getvar "FILLETRAD"))  
(initget 7 "Р") 
(setq pt1 (getpoint "\n Начальная точка или [Радиус]: ")) 
(if (= pt1 "Р")
    (progn
    (princ " Радиус сопряжения <") (princ (getvar "FILLETRAD")) (princ "> или указать 2 точки: ")
    (initget 5)
    (setq rd (getdist))
    (setvar "FILLETRAD" rd) 
    (setq pt1 (getpoint "\n Начальная точка: ")) 
    )
)
(initget "Отмени Undo _Undo Undo") 
(while (setq pt2 (getpoint pt1 "\n Следующая точка [Отмени] <Enter-Выход>: ")) 
  (cond 
     ((listp pt2) ;_Указана точка 
      ;;;Запоминаем в переменных USERR1 и USERR2 X и Y указанной точки 
      ;;;в мировых координатах. Это позволит пользователю прозрачно менять ПСК 
      (setvar "USERR1" (car (trans pt1 1 0))) ;;;Запоминаем X точки pt1 в МСК 
      (setvar "USERR2" (cadr (trans pt1 1 0)));;;Запоминаем Y точки pt1 в МСК 
      (command "_.UNDO" "_M")                 ;;;Ставим метку UNDO 
      (command "_.LINE" "_none" pt1 "_none" pt2 "")

      (setq lay (vlax-get-property (vlax-ename->vla-object (entlast)) 'layer))
      (setq dlina (/ (vlax-get-property (vlax-ename->vla-object (entlast)) 'length) 1000)) ; в метрах
;      (setq dlina (vlax-get-property (vlax-ename->vla-object (entlast)) 'length))
      (setq ugol (vlax-get-property (vlax-ename->vla-object (entlast)) 'angle))
      (setq ugol (* (/ 180 pi) ugol))
      (setq lay_dlina (strcat lay "_длина"))
      (vl-cmdf "_-LAYER" "_m" lay_dlina "_c" "1" "" "_p" "_no" "" "")


      (setvar "USERS1" (getvar "USERS2"))  ;;;Перемещаем метку 2-го примитива в 1-й 
      (setvar "USERS2" (cdr(assoc 5 (entget (entlast))))) ;;Метка последнего примитива
      (setq kod40 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
      (if (= kod40 0)
      (vl-cmdf "_TEXT" "_m2p" pt1 pt2 "" ugol (rtos dlina 2 0))
      (vl-cmdf "_TEXT" "_m2p" pt1 pt2 ugol (rtos dlina 2 0))
      )
      (setvar "CLAYER" lay)
      (if (and (setq ent1 (handent (getvar "USERS1")))  ;;; Примитив существует 
               (setq ent2 (handent (getvar "USERS2")))  ;;; Примитив существует 
               (entget ent1)  ;;; Примитив не удален 
               (entget ent2)  ;;; Примитив не удален 
               ) 
        (vl-cmdf "_.FILLET"  ent1 ent2) 

        ;;;Сопрягаем 
        )
      (setq U_M (1+ U_M)) ;;;VVA
      (setq pt1 pt2) 
      ) 
     ((= pt2 "Undo") 
      (if (> U_M 0) ;;;Если есть что отменять 
        (progn 
       (command "_.UNDO" "_B")
       (setq U_M (1- U_M)) ;;;VVA
       (setq pt1 (list (getvar "USERR1") (getvar "USERR2"))) 
           (setvar "LASTPOINT" (setq pt1 (trans pt1 0 1))) 
          ) 
        (alert "Отменять больше нечего") 
        ) 
      ) 
     (t nil) 
     ) 
(initget "Отмени Undo _Undo Undo") 
) 
  ;;;Нужно собрать все в полилинию 
  (if (and toPline eLast) 
    (progn 
     (setq ss (ssadd)) 
     (while (setq  eLast (entnext  eLast))(ssadd  eLast ss)) 
     (if (= (sslength ss) 0)(setq ss nil)) ;;; Пустой набор 
     (if ss ;;;что-то есть 
       (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1)) 
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Join" 0 "") 
         (vl-cmdf "_pedit" "_Multiple" ss "" "_Y" "_Join" 0 "") 
         ) 
       ) 
     (setq ss nil) 
      ) 
    )
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(mapcar '(lambda(x)(setvar (car x)(cdr x))) usr_list)
(vl-cmdf "_TEXT" "0,0" "" "0" "1")
(entdel (entlast))
(princ) 
)
(princ "\n Ввести в командной строке СЕТИ или СЕТИ_ПЛ")
(princ)

или код из сообщения 30 отсюда:
http://forum.dwg.ru/showthread.php?t=30439

[dextron3]

Profan, отличный лисп!, первый не понравился потому что там цыфры пишуться, а на дугах не пишуться при скруглении смысла тогда не вижу, а второй лисп из поста 30 очень даже ничего взял на обеспечение, теперь хоть генпланы будут доступны обыденным пользователям када

Вот хотел спросить есть ли такая опция в автокаде:

1. Выделяем набор линий в автокаде прямоуголным выделением
2. Вводим радиус скругления
3. Все линии в обалсти скругляются, а именно скругление происходит у пересекаающихся или касающихся линий к примеру смотреть сриншоты:

[IMG]http://s59.***********/i166/1008/d2/df16d3aea915t.jpg[/IMG]

желтым обозначил места где радиус скругления больше чем длина линий

вот такой бы лисп...