[Victor]

Программа не коммерческая, поэтому нет проверок на введёные значения, на ошибки. Кому нужно добавляйте. Прога расставляет блоки с начала линии (не с конца). Надавно это обнаружил и долго не мог сообразить, в чём же дело, но реверс линии лень было добавлять.
Нумерует атрибут. Суффикс, префикс.
Редактируйте эти строки под свой стандарты
Масштаб (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]

нашёл какой-то

[otsva]

Может есть lisp или команда расстановки блоков вдоль линии, полилинии с возможность задания длины для каждого блока.
Нужно разместить блоки вдоль линии, полилинии через определенное не одинаковое расстояние.
Спасибо!

[kegorovsc]

Сообщение от Victor Без проверок на наличие блока, полилинии, виндовса, прокладки между монитором и стулом. 15 минут у меня было.

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

[VVA]

Сообщение от kegorovsc тличная команда, но у меня почему то вставляет два блока в точку - один поверх другого.

привязка грабли №1
Найди строку

(command "_.insert" name_of_bl krd scl scl ugol_pl_gr)

Замени

(command "_.insert" name_of_bl "_non" krd scl scl ugol_pl_gr)

Без проверки но должно работать
Что такое "_non"

[n0str0m0]

Приветствую. Скажите, получается, что b2l.lsp расставляет только блоки с атрибутами?
А если блок без атрибутов, то он ставит этот блок только в начальную точку полилинии и на этом заканчивает работу.
1Можно ли сделать так, чтобы любые блоки вставлялись в узлы полилинии?
2 Можно ли сделать так, чтобы блоки на ломаной/криволинейной полилинии расставлялись без наклона, перпендикулярному сегменту полилинии?

[n0str0m0]

Установил себе и вот что получается, см. во вложенном файле:
В первом случае лисп расставляет блок только в первую вершину полилини, в остальные никак (у меня единственное объяснение: у блока нет атрибутов)
Во втором случае блоки расставляет по одному, для каждой последующей вставки необходим клик ЛКМ в любом месте. Причем атрибуты во всех вершинах расположены горизонтально.
В третьем случае блок автоматом расставляется по всем вершинам полилинии, но уже с разворотом
Подскажите, в чем принципиальная разница между этими тремя блоками, что лисп b2l по разному их обрабатывает?
Особенно интересна разница между вторым и третьим случаем.

[АлексЮстасу]

Сообщение от n0str0m0 Возникла необходимость расставить блоки в вершинах полилинии не вручную, а автоматически.

Попробуйте перенести все на положительные координаты - может быть в этом дело?
Еще можно удалить прокси - они есть. Есть следы СПДС.
-----
Про координаты и пр. предположения, скорее мистические.
Например, в этом файле Purge-Очистить не предлагает вычистить блоки, хотя их описаний в файле много. Т.е. описания блоков в файле как бы есть, но их как бы и нет.

[n0str0m0]

Насчет описаний блоков в файле: не знаю даже, где это искать.
В другом файле, где координаты положительные, всё то же самое.
К тому же совершенно не пойму, почему блоки 2 и 3 ведут себя совершенно по разному при прочих равных

[berstrider]

Не с первого раза, но смог запустить Лисп из топикстартера.
Такой вопрос: А как можно обработать предварительно выбранную группу полилиний или отрезков?

Задача такая, приходит файл контуров, надо по определённым группам полилиний расставить соответствующие блоки бортовых камней.

[name02]

Можешь вот это попробовать:

Код:

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

 (vl-load-com)
(defun c:b2l (/		sc	  bl	    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)
  ) ;_ end of if
  (if (not (new_dialog "b2l" dcl_id))
    (exit)
  ) ;_ end of if
  (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))"
  ) ;_ end of action_tile
  (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)
	     ) ;_ end of list
    ) ;_ end of entmake
  ) ;_ end of if
  (setvar "Clayer" name_of_bl)

  ;; Предварительно выбранный набор объектов
  (setq ss (cadr (ssgetfirst)))

  (cond
    ;; Если предварительного набора нет
    ((null ss)
     (princ "\Выберите отрезки или полилинии: ")
     (setq ss (ssget '((0 . "*LINE"))))
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    )
    ;; Если есть предварительно выбранные объекты
    (T
     (setq lst (vl-remove-if-not
		 '(lambda (x)
		    (wcmatch (cdr (assoc 0 (entget x))) "*LINE")
		  ) ;_ end lambda
		 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	       ) ;_ end vl-remove-if
     ) ;_ end setq
    )
  ) ;_ end cond

  ;;Проходим список объектов и размещаем блоки
  (foreach pln lst
    ;;;(setq pln (car (entsel)))
    (setq dis_pl (vlax-curve-getDistAtParam pln (vlax-curve-getEndParam pln)))
    (setq dis_run (- 0.0 dis)
	  i	  (- strt stp)
    ) ;_ end of setq
    (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))
	  ) ;_ end of progn
	  (setq ugol_pl_gr 0.0)
	) ;_ end of if
	(setvar "attreq" 0)
	(command "_.insert" name_of_bl "_non" krd scl scl ugol_pl_gr) ;_ end of command
	(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)))
	  ) ;_ end of progn
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of while

  ) ;_ end of foreach
  (setvar "Osmode" snp)
  (command "_.undo" "_end")
) ;_ end of defun