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

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

Расстановка блоков вдоль линии, полилинии, сплайна

Ответ
Поиск в этой теме
Непрочитано 26.06.2010, 11:27 2 |
Расстановка блоков вдоль линии, полилинии, сплайна
Victor
 
Бат-Ям
Регистрация: 14.06.2009
Сообщений: 293

Программа не коммерческая, поэтому нет проверок на введёные значения, на ошибки. Кому нужно добавляйте. Прога расставляет блоки с начала линии (не с конца). Надавно это обнаружил и долго не мог сообразить, в чём же дело, но реверс линии лень было добавлять.
Нумерует атрибут. Суффикс, префикс.
Редактируйте эти строки под свой стандарты
Масштаб (setq sc '("0.05" "0.10" "0.25" "0.50" "1.00" "2.50" "5.00"))
Имя блока (setq bl '("BL1" "BL2" "BL3" "BL4" "BL5"))
dcl файл сохранить как b2l.dcl
Код:
[Выделить все]
b2l  : dialog { label = "Block to polyline" ;				     		   
:spacer{height=1;}
: row {label = "";
   : column {label = "Scale";			      			
      : popup_list {			        
        value = "4"; key=b1;width=15;}				
        }		 
:spacer{width=1;}
   : column {			
      label = "Block";			
      : popup_list {				
        value = "0"; key=b2;width=15;}				
        }		
} 
:spacer{height=1;}
: row {label = "Dimensions";
: column {label = "";
:spacer{width=7;}
}
: edit_box  {label="Distance";edit_width=7;key="ds_s";}
: column {label = "";
:spacer{width=7;}
}
}

:toggle{label="Use atribute";key="att";value="1";}
:toggle{label="Alignment";key="aln";value="1";}

:spacer{height=1;}
: row {label = "";
   : column {label = "Numbers";
   : edit_box  {label="Start";edit_width=5;key="st_s";}
   : edit_box  {label="Step" ;edit_width=5;key="sp_s";}
}
:spacer{width=1;}
   : column {label = "Letters";
   : edit_box  {label="Prefix";edit_width=5;key="pf_s";}
   : edit_box  {label="Suffix";edit_width=5;key="sf_s";}
}
}      
:spacer{height=1;}
ok_cancel;
}
лисп файл
Код:
[Выделить все]
(vl-load-com)
(defun c:b2l ( / name_of_bl dis pln dis_pl dis_run i krd prm_pnt
                 proiz ugol_pl ugol_pl_gr my_blok my_att spis_att
                 att_old att_new spis_att strt stp)
(command "_.undo" "_begin") 
(setq sc '("0.05" "0.10" "0.25" "0.50" "1.00" "2.50" "5.00"))
(setq bl '("BL1" "BL2" "BL3" "BL4" "BL5"))
(if(<(setq dcl_id(load_dialog"b2l"))0)(exit))
(if(not(new_dialog"b2l" dcl_id))(exit))
  (start_list "b1")				
  (mapcar 'add_list sc)				
  (end_list)
  (start_list "b2")				
  (mapcar 'add_list bl)				
  (end_list)
(action_tile"accept"						
     "(setq scl (atof (get_tile \"b1\")))	
      (setq blk (atof (get_tile \"b2\")))
      (setq dis (atof (get_tile \"ds_s\")))
      (setq strt (atoi(get_tile \"st_s\")))
      (setq stp  (atoi(get_tile \"sp_s\")))
      (setq atr  (atoi(get_tile \"att\")))
      (setq alg  (atoi(get_tile \"aln\")))
      (setq pref (get_tile \"pf_s\"))
      (setq suff (get_tile \"sf_s\"))
      (done_dialog)(setq userclick T))")		
(action_tile"cancel" "(done_dialog)(exit)")
(start_dialog)
(unload_dialog dcl_id)
(setq sc_s (nth (fix scl) sc))
(setq name_of_bl (nth (fix blk) bl))
(setq snp (getvar "Osmode"))
(setvar "Osmode" 0) 
(setq scl sc_s)
(if(not (tblsearch "layer"  name_of_bl))
(entmake(list '(0 . "LAYER" )'(100 . "AcDbSymbolTableRecord")
              '(100 . "AcDbLayerTableRecord")'(70 . 0)(cons 2 name_of_bl)'(62 . 7))))
(setvar "Clayer" name_of_bl)
(setq pln (car (entsel)))
(setq dis_pl (vlax-curve-getDistAtParam pln (vlax-curve-getEndParam pln)))
(setq dis_run (- 0.0 dis) i (- strt stp))
(while(< (+ dis_run dis) dis_pl)
 (progn
 (setq i (+ i stp))
 (setq dis_run (+ dis_run dis))
 (setq krd (vlax-curve-getPointAtDist pln dis_run))
 (setq prm_pnt  (vlax-curve-getParamAtPoint pln krd))
 (if(= alg 1)
    (progn
    (setq proiz (vlax-curve-getFirstDeriv pln prm_pnt))
    (setq ugol_pl (angle '(0 0 0) proiz))
    (setq ugol_pl_gr (* ugol_pl 57.29747))
    ) ;progn
    (setq ugol_pl_gr 0.0)
 ) ;if
 (setvar "attreq" 0)
 (command "_.insert" name_of_bl krd scl scl ugol_pl_gr)
 (if(= atr 1)
    (progn
    (setq my_blok (entlast))
    (setq my_att (entnext my_blok))
    (setq spis_att (entget my_att)) ;spisok 
    (setq att_old (assoc 1 spis_att)) ;name
    (setq num_new (itoa i))
    (setq num_new (strcat pref num_new suff))  
    (setq att_new (cons 1 num_new)) ;
    (setq spis_att (subst att_new att_old spis_att)); zamena
    (entmod spis_att)
    (entupd  (cdr (assoc -1 spis_att)))
    ) ;progn
  ) ;if
 ) ;progn
)
(setvar "Osmode" snp)
(command "_.undo" "_end") 
)

Последний раз редактировалось Victor, 26.06.2010 в 14:11.
Просмотров: 29938
 
Непрочитано 11.04.2012, 02:31
#21
АлексЮстасу

топограф, технолог
 
Регистрация: 24.05.2009
Москва
Сообщений: 2,715


Цитата:
Сообщение от Victor Посмотреть сообщение
Переделал. Кликайте сначала и с конца. В файле primer разные варианты работы программы, в зависимости от положения галочек - атрибут, блок.
Загрузил b2l.VLX в 2008, в 2012, вызвал "b2l" - реакция отсутствует полностью.
Загрузил b2l.lsp из предыдущего сообщения - реакции тоже никакой. Что-то не так делаю?

В целом - программа под какие Автокады?

Последний раз редактировалось АлексЮстасу, 11.04.2012 в 23:08.
АлексЮстасу вне форума  
 
Непрочитано 23.08.2012, 12:41
#22
Джаз


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


Хотел создать новую тему, но в поиске нашёл подходящее общение здесь
На топосъёмках расставляем опоры ЛЭП с указанием связи/направления проводов на предыдущую/следующую опоры. Блок выглядит так O--->. Базовая точка в центре круга. Хочу выбирая точки (съёмочные пикеты) по порядку расставлять на них по 2 блока. Один будет направлен на предыдущую опору, другой на следующую. Т.е. вот так <---O--->. И пройдя по порядку по всем точкам отрисовать ЛЭП в условных знаках.
P.S. Сейчас копированием расставляем блоки по точкам. Потом эти блоки вручную вращаем ориентируя направление на предыдущую/следующую опоры. Не айс.
Джаз вне форума  
 
Автор темы   Непрочитано 23.08.2012, 13:53
1 | #23
Victor


 
Регистрация: 14.06.2009
Бат-Ям
Сообщений: 293


Без проверок на наличие блока, полилинии, виндовса, прокладки между монитором и стулом. 15 минут у меня было.
Вложения
Тип файла: lsp l2p.lsp (1.1 Кб, 413 просмотров)
__________________
... а Автокад то - голый
Victor вне форума  
 
Непрочитано 23.08.2012, 15:33
#24
Джаз


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


Спасибо, добрый человек.
Работает даже лучше, чем хотел.
В узлах полилинии расставляет пары блоков.
Тут я набираюсь наглости...
Только ориентировка одного отличается на 180гр от нужной.
Вот так есть.


А надо так.


Сам боюсь ваш код трогать. Скажите, пожалуйста, что подправить?
Миниатюры
Нажмите на изображение для увеличения
Название: Netak.jpg
Просмотров: 2104
Размер:	22.2 Кб
ID:	85926  Нажмите на изображение для увеличения
Название: Tak.jpg
Просмотров: 2076
Размер:	17.4 Кб
ID:	85927  
Джаз вне форума  
 
Непрочитано 23.08.2012, 15:43
#25
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,400
<phrase 1=


Джаз, Что мешает создать 2 зеркальных блока? Религия?
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 23.08.2012, 15:52
#26
Джаз


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


Потом 2 раза воспользоваться Лиспом, выбрать неправильно ориентированные пары блоков и удалить.
В принципе вариант.
Но я всё же подожду помощи Виктора.


Добавлено.
Разобрался. Понял как пишутся процедуры в Лиспе.
Код:
[Выделить все]
 (vl-load-com) 
(defun in_bl (name_of_bl pln krd j dir / ugol_pl ugol_pl_gr )
(setq prm_pnt (+ j (* dir 0.1)))
(setq proiz (vlax-curve-getFirstDeriv pln prm_pnt))
(setq ugol_pl (angle '(0 0 0) proiz))
(setq ugol_pl_gr (* ugol_pl 57.29747))
(command "_.insert" name_of_bl krd 1.0 1.0 ugol_pl_gr)
)
(vl-load-com) 
(defun in_bla (name_of_bl pln krd j dir / ugol_pl ugol_pl_gr )
(setq prm_pnt (+ j (* dir 0.1)))
(setq proiz (vlax-curve-getFirstDeriv pln prm_pnt))
(setq ugol_pl (angle '(0 0 0) proiz))
(setq ugol_pl_gr (+ (* ugol_pl 57.29747) 180))
(command "_.insert" name_of_bl krd 1.0 1.0 ugol_pl_gr)
)

(defun c:l2p ( / snp cmdh name_of_bl pln krd num j )
(command "_.undo" "_begin")
(setq snp (getvar "Osmode"))
(setq cmdh (getvar "CMDECHO"))
(setvar "Osmode" 0) 
(setvar "CMDECHO" 0)
(setq name_of_bl (getstring "\nName of blok?  "))
(setq pln (car (entsel)))
(setq krd (vlax-curve-getPointAtParam pln 0))
(in_bl name_of_bl pln krd 0.0 1.0)
(setq num (fix(-(vlax-curve-getEndParam pln) 1)))
(setq j 0)
(repeat num
   (setq j (1+ j))
   (setq krd (vlax-curve-getPointAtParam pln j))
   (in_bla name_of_bl pln krd j -1.0)
   (in_bl name_of_bl pln krd j 1.0)
)
(setq krd (vlax-curve-getPointAtParam pln (+ 1 num)))
(in_bla name_of_bl pln krd (+ 1 num) -1.0)
(setvar "Osmode"  snp) 
(setvar "CMDECHO" cmdh)
(command "_.undo" "_end")
)
    
Виктор, ещё раз спасибо.
Миниатюры
Нажмите на изображение для увеличения
Название: 2netak.jpg
Просмотров: 2161
Размер:	15.0 Кб
ID:	85931  

Последний раз редактировалось Джаз, 23.08.2012 в 17:31.
Джаз вне форума  
 
Непрочитано 06.12.2012, 11:13
#27
Иван Павлов


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


Может я что-то не так делаю, но прога не запускается:
Команда: B2L
; ошибка: завершить / выйти прервать

Лисп взял с 1 сообщения, Autocad 2012 rus, Win 7? 64bit.
Иван Павлов вне форума  
 
Непрочитано 15.12.2013, 23:39
#28
potrox


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


Подскажите пожалуйста, что нужно дописать чтоб при выборе можно было выбрать несколько полилиний?
potrox вне форума  
 
Непрочитано 21.12.2013, 16:18
#29
Джаз


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


Цитата:
Сообщение от potrox Посмотреть сообщение
Подскажите пожалуйста, что нужно дописать чтоб при выборе можно было выбрать несколько полилиний?
Здесь добрый человек выложил нужное вам, правда скомпилированное в .fas
http://geodesist.ru/forum/threads/%D...5/#post-330971
Джаз вне форума  
 
Непрочитано 21.12.2013, 18:23
#30
potrox


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


спасибо)
potrox вне форума  
 
Непрочитано 17.12.2014, 11:42
#31
Rassol11


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


Всем здравствуйте!
Нужно то же, что нужно было Джаз
Цитата:
Сообщение от Джаз Посмотреть сообщение
На топосъёмках расставляем опоры ЛЭП с указанием связи/направления проводов на предыдущую/следующую опоры. Блок выглядит так O--->. Базовая точка в центре круга. Хочу выбирая точки (съёмочные пикеты) по порядку расставлять на них по 2 блока. Один будет направлен на предыдущую опору, другой на следующую. Т.е. вот так <---O--->. И пройдя по порядку по всем точкам отрисовать ЛЭП в условных знаках.
P.S. Сейчас копированием расставляем блоки по точкам. Потом эти блоки вручную вращаем ориентируя направление на предыдущую/следующую опоры. Не айс.
, воспользовался его лиспом. Он расставляет блоки по вершинам полилинии, но стрелки от условного знака ЛЭП не смотрят каждая на предыдущую и на послледующую.
Может быть, у меня что-то с блоком моим не то? Прикладываю свой блок.
Подскажите, пожалуйста.
Вложения
Тип файла: dwg
DWG 2007
???_2009.dwg (167.0 Кб, 2173 просмотров)
Rassol11 вне форума  
 
Непрочитано 17.12.2014, 12:02
1 | #32
Джаз


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


Попробуйте этот блок.
Столб_ЛЭП
Вложения
Тип файла: dwg
DWG 2007
Столб_ЛЭП.dwg (68.3 Кб, 2226 просмотров)
Джаз вне форума  
 
Непрочитано 17.12.2014, 13:49
#33
Rassol11


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



Cпасибо большое! Вы спасли весь наш офис от долгих мучений!
Rassol11 вне форума  
 
Непрочитано 06.03.2015, 17:00
#34
boretskiy.a


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


Вообще-то проблема не в блоке, а в формате представления угловых данных, должны быть только не грады или радианы, а градусы или градусы минуты секунды.
boretskiy.a вне форума  
 
Непрочитано 01.10.2015, 12:29
#35
Air81


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


Лисп в шапке почему то не работает в русской версии Autocad 2015 (WIN 7, 64). Вот что выдает на команду b2l
"
Команда: B2L
_.undo Текущие настройки: Авто = Вкл, Управление = Все, Объединить = Есть, Слой = Есть
Количество отменяемых операций или [Авто/Управление/Начало/Конец/Метка/Обратно] <1>: _begin
Команда: ; ошибка: завершить / выйти прервать
"
Что не так делаю?

Последний раз редактировалось Air81, 01.10.2015 в 12:52.
Air81 вне форума  
 
Непрочитано 02.10.2015, 00:00
#36
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,550


видимо лисп не находит диалог и завершается выходом с обработкой ошибки... как вариант можно скомпилировать его или положить на видимое место диалог
gomer вне форума  
 
Непрочитано 03.11.2015, 15:11
#37
anyasl


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


Цитата:
Сообщение от Shaft Посмотреть сообщение
А если надо чтобы блоки вставлялись в только в вершинах полилинии, а не через заданное расстояние? Кто-нибудь знает как такое можно реализовать...
Здравствуйте.
У меня ровно такая же потребность - расставить блоки вдоль полилинии строго по ее вершинам. Пыталась я читать про лиспы, но пользоваться не умею и в сознании прочтенное не отложилось.
Помогите, объясните плиз?
anyasl вне форума  
 
Непрочитано 30.12.2015, 19:18
#38
АлексЮстасу

топограф, технолог
 
Регистрация: 24.05.2009
Москва
Сообщений: 2,715


Цитата:
Сообщение от Леонид Ильич Посмотреть сообщение
а если нужно расставить не по вершинам, а с определённой дистанцией?
Для этого есть штатная _MEASURE.
Цитата:
Сообщение от anyasl Посмотреть сообщение
Пыталась я читать про лиспы, но пользоваться не умею
Как использовать лисп.
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума  
 
Непрочитано 16.02.2016, 12:46
#39
boretskiy.a


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


Цитата:
anyasl расставить блоки вдоль полилинии строго по ее вершинам. Пыталась я читать про лиспы, но пользоваться не умею и в сознании прочтенное не отложилось.
Помогите, объясните плиз?
Код:
[Выделить все]
 (vl-load-com)
(defun in_bl (name_of_bl pln krd j dir / ugol_pl ugol_pl_gr )
(setq prm_pnt (+ j (* dir 0.1)))
(setq proiz (vlax-curve-getFirstDeriv pln prm_pnt))
(setq ugol_pl (angle '(0 0 0) proiz))
(setq ugol_pl_gr (* ugol_pl 57.29747))
(command "_.insert" name_of_bl krd 1.0 1.0 ugol_pl_gr)
)
(vl-load-com)
(defun in_bla (name_of_bl pln krd j dir / ugol_pl ugol_pl_gr )
(setq prm_pnt (+ j (* dir 0.1)))
(setq proiz (vlax-curve-getFirstDeriv pln prm_pnt))
(setq ugol_pl (angle '(0 0 0) proiz))
(setq ugol_pl_gr (+ (* ugol_pl 57.29747) 180))
(command "_.insert" name_of_bl krd 1.0 1.0 ugol_pl_gr)
)
 
(defun c:l1p ( / snp cmdh name_of_bl pln krd num j )
(command "_.undo" "_begin")
(setq snp (getvar "Osmode"))
(setq cmdh (getvar "CMDECHO"))
(setvar "Osmode" 0)
(setvar "CMDECHO" 0)
(setq name_of_bl "bl1.dwg")
(setq pln (car (entsel)))
(setq krd (vlax-curve-getPointAtParam pln 0))
(in_bl name_of_bl pln krd 0.0 1.0)
(setq num (fix(-(vlax-curve-getEndParam pln) 1)))
(setq j 0)
(repeat num
   (setq j (1+ j))
   (setq krd (vlax-curve-getPointAtParam pln j))
   (in_bla name_of_bl pln krd j -1.0)
   (in_bl name_of_bl pln krd j 1.0)
)
(setq krd (vlax-curve-getPointAtParam pln (+ 1 num)))
(in_bla name_of_bl pln krd (+ 1 num) -1.0)
(setvar "Osmode"  snp)
(setvar "CMDECHO" cmdh)
(command "_.undo" "_end")
)
Макрос на кнопку
^C^C^P(if (tblsearch "layer" "НАДЗЕМКА")(command "_layer" "_set" "НАДЗЕМКА" "")(command "_layer" "_make" "НАДЗЕМКА" "") );^Pl1p;
Проводиш полилинию и жмем кнопочку, все расставлено.
LSP код и вложенный файл блока должны бить в папке доступа.
Удачи!

bl1.dwg
boretskiy.a вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > Расстановка блоков вдоль линии, полилинии, сплайна

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание нового типа линий Apelsinov AutoCAD 903 16.07.2019 16:20
Текст вдоль полилинии или сплайна (по кривой) Denioska AutoCAD 45 01.06.2018 13:01
Выдавливание вдоль линии (VBA) Markiza-2010 Программирование 4 29.03.2010 02:36
Как при помощи лиспа нарисовать цепочку окружностей вдоль воображаемой линии Serge_BN LISP 8 18.03.2010 20:32
Как пустить текст вдоль изогнутой линии? Shaft AutoCAD 47 01.06.2009 16:13