Расстановка пикетов по трассе водопровода. Расстановка колодцев по трассе канализации.

jackUAROBEY · 05.07.2016, 14:09

Программа для проектировщиков сетей водопровода и канализации. Жду замечаний и предложений.
Добавил изменения по замечаниям, вроде все ок.

Кулик Алексей aka kpblc · 05.07.2016, 14:16

Язык не указать было изначально? Где хотя бы минимальное описание? В lsp нарушена кодировка. Зачем столько глобальных переменных? Нет обработчика ошибок. pi является константой. Команды указаны с использованием русских опций. Ну и т.д.
В качестве рабочей версии использовать не советую никому.

jackUAROBEY · 05.07.2016, 16:22

Благодарю что не обошли вниманием.
1. Не совсем понял в чем нарушена кодировка, но на всякий случай подравнял строки.

2. Изначально программа писалась на два масштаба. Здесь не стал удалять вдруг кто нибудь будет в другом масштабе работать. В данном случае Lisp написан под масштаб 1:1.
3. Если имеется ввиду функция errror то добавил. У меня как то без неё работало.
4. Про Pi не совсем понял. Если можно поподробней.
5. Заменил русские команды на международные.
6. Ну и т.д. жду.
Последнюю версию файла см. В первом посте.

Код:

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

 
(progn  
  (princ " \nНаберите в командной строке:")	 
  (princ "\nТрасса - обрабатывает трассу ")
  (princ "\nвернуть - возвращает к исходному")
  )
(defun *error* (msg) (princ "Выход!!!")
  (command-s "_.UCS" "" )
  (setvar "CELWEIGHT" snn)
  (setvar "CLAYER" CСLAYER)
  (setvar "insunits" snpp)
  (setvar "Osmode"  snp)
  (setvar "CMDECHO" cmdh)
  );error

(setq CСLAYER (getvar "CLAYER")) ;текущий слой
;(setvar "CLAYER" "Водопровод и канализация") ; сменить слой
(setq snn (getvar "CELWEIGHT"))
(setvar "CELWEIGHT" -1)
(setq masche "М2")
;введены переменные ибо программа разрабатываласть на два масштаба в данной версии остался один масшта
;но при желании можно изменить значение переменных под свои условия
 (progn
  (setq rasst_pk 100) ;расстояние между пикетами для М2-1 100 для м1-100 20000
  (setq pl_vinoska_t2 5) ; координата полки мультивыноси для М2-1 5 для м1-100 1000
  (setq pl_vinoska_t3 3) ; координата полки мультивыноси для М2-1 3 для м1-100 500
  (setq pk_blok "ПК_") ;название блока пикета 
  (setq ram_text "4") ; ширина рамки текст для М2-1 "4" для м1-100 "500"
  (setq ram_textt "2") ; ширина рамки текст для М2-1 "2" для м1-100 "300"
  (setq m_koef 1) ;для М2-1 1 для М1-100 200
  (setq pk_blok_kol "Kolodec_")
  )
(Defun c:Трасса ( / dcl_id wath koordin diametr)
    (vl-load-com) ; загружаем функции расширения
  (setq acad_object (vlax-get-acad-object))                   ; указатель на программу AutoCAD
  (setq active_document (vla-get-activedocument acad_object)) ; указатель на активный документ
  (setq model_space (vla-get-modelspace active_document)) 
  (command "_.undo" "_m")
  (setq dcl_id (load_dialog "трасса.dcl"))
  (if (not (new_dialog "np_tpos" dcl_id)) (exit))
  (action_tile "NAP" "(napor dcl_id)")
  (action_tile "samot" "(samo dcl_id)")
  (action_tile "VOD" "(VODO dcl_id)")
  (setq koordin "TOCH")
  (setq trub "NAPorn")
  (setq flagok "0")
  (setq wath 8)
  (while (< 2 wath )
    (action_tile "TOCH" "(setq koordin $key)")
    (action_tile "KORD" "(setq koordin $key)")
    (action_tile "NAPorn" "(setq trub $key)")
    (action_tile "samotechn" "(setq trub $key)")
   (action_tile "vodopro" "(setq trub $key)")
    (action_tile "flag" "(setq flagok $value)") 
    (setq wath (start_dialog))
    )  
  (unload_dialog dcl_id)  
  (setq pln (car (entsel"\nВыберите трассу:")))
  (if (= flagok "1")    
      (if (= koordin "TOCH")
	(МВ8)
	(МВ9)
	)  
    ()
    )
  (if (= trub "NAPorn")
    (progn
      (МВ7) ; угол поворота
      (МВ3) ; пикет
      (МТ1) ; наименование трубопровода
      )
   (if (= trub "samotechn")
    (if (= AUTO "1") (к1) (к11)))
    )
  (setvar "CLAYER" CСLAYER)
(setvar "CELWEIGHT" snn)
  (princ)
  )
;__________________________________________________________________________________
(defun мв7 ( /  stp   j num krd proiz+1 proiz-1 ugol_pL+1 ugol_pl_gr+1 ugol_pL-1 ugol_pl_gr-1 ugol_pl_gr
	     dis_pl dis_PK dis_dis dis_dis_p dis_p t2 i my_leader spis_mleader	att_old	 num_new att_new); исходные данные
  (vl-load-com) ; угол поворота пикет
  (setq stp 1)  
  (setq j 0)
  (setq i (- strtr stp)) 
  (while (setq proiz+1 (vlax-curve-getPointAtParam pln (+ (+ j 1) 1)))
    (setq ugol_pL+1 0)
    (setq ugol_pL-1 3.14159)
    (while (= (rtos (abs (- ugol_pl-1 ugol_pl+1)) 2 5 ) (rtos pi 2 5 ))
      (setq j (1+ j))    
      (setq krd (vlax-curve-getPointAtParam pln j))
      (if (/=  (vlax-curve-getPointAtParam pln (+ j 1)) nil)
	(progn
	  (setq proiz+1 (vlax-curve-getPointAtParam pln (+ j 1)))
	  (setq proiz-1 (vlax-curve-getPointAtParam pln (- j 1)))
	  (setq ugol_pL+1 (angle krd proiz+1))
	  (setq ugol_pL-1 (angle krd proiz-1))
	  )
	(progn
	  (setq ugol_pL+1 3.14)
	  (setq ugol_pL-1 3.14)
	  )
	)
      )
    (setq ugol_pl (if (> ugol_pl-1 ugol_pl+1)
		    (if (> pi (- ugol_pl-1 ugol_pl+1)) (- ugol_pl-1 ugol_pl+1) (+ (- (* 2 pi) ugol_pl-1) ugol_pl+1))
		    (if (> pi (- ugol_pl+1 ugol_pl-1))  (- ugol_pl+1 ugol_pl-1) (+ (- (* 2 pi) ugol_pl+1) ugol_pl-1))
		    )
	  )
    (setq  ugol_pl_gr (angtos  ugol_pl 1 2))
    (setq dis_pl (vlax-curve-getDistAtParam pln j))
    (setq dis_PK (itoa (+ strPK (fix (/ dis_pl rasst_pk )))))
    (setq dis_p (vl-string-subst "," "." ( rtos (* (- (/ dis_pl rasst_pk ) (fix (/ dis_pl rasst_pk ))) 100) 2 1)))
    (setq t2 (list (+ (car krd) pl_vinoska_t2) (+ (cadr krd) pl_vinoska_t2) 0))
    (command "_.MLEADER" krd t2 "text")
    (setq i (+ i stp))
    (setq my_mleader (entlast))
    (setq spis_mleader (entget my_mleader))
    (setq att_old (assoc 304 spis_mleader))
    (setq num_new (itoa i))
    (setq num_new  (strcat "УП-" num_new " "  (vl-string-subst "%%d" "d" ugol_pl_gr)  "\nПК" dis_pk  "+" dis_p ))
    (setq att_new (cons 304 num_new))
    (setq spis_mleader (subst att_new att_old spis_mleader))
    (entmod spis_mleader)
    (entupd (cdr (assoc -1 spis_mleader)))
    )
  (princ)
  )

;_______________________________________________________________________________
(defun мв8 ( /  stp pref suff  j num krd t2 i my_leader spis_mleader
	att_old	 num_new att_new )
  (vl-load-com) ; номер точки координат
  (setq stp 1) 
  (setq pref "т.")
  (setq suff "")
  (setq j 0)
  (setq i (- strt stp))
 ;первая точка
  (setq krd (vlax-curve-getPointAtParam pln j))
  (setq t2 (list (+ (car krd) pl_vinoska_t3) (- (cadr krd) pl_vinoska_t3) 0))
  (command "_.MLEADER" krd t2 "text")
  (setq i (+ i stp))
  (setq my_mleader (entlast))
  (setq spis_mleader (entget my_mleader))
  (setq att_old (assoc 304 spis_mleader))
  (setq num_new (itoa i))
  (setq num_new (strcat pref num_new suff))
  (setq att_new (cons 304 num_new))
  (setq spis_mleader (subst att_new att_old spis_mleader))
  (entmod spis_mleader)
  (entupd (cdr (assoc -1 spis_mleader)))  
; следующие точки  
  (while (setq proiz+1 (vlax-curve-getPointAtParam pln (+ (+ j 1) 1)))
    (setq ugol_pL+1 0)
    (setq ugol_pL-1 3.14159)
    (while (= (rtos (abs (- ugol_pl-1 ugol_pl+1)) 2 5 ) (rtos pi 2 5 ))
      (setq j (1+ j))      
      (setq krd (vlax-curve-getPointAtParam pln j))
      (if (/=  (vlax-curve-getPointAtParam pln (+ j 1)) nil)
	(progn
	  (setq proiz+1 (vlax-curve-getPointAtParam pln (+ j 1)))
	  (setq proiz-1 (vlax-curve-getPointAtParam pln (- j 1)))
	  (setq ugol_pL+1 (angle krd proiz+1))
	  (setq ugol_pL-1 (angle krd proiz-1))
	  )
	(progn
	  (setq ugol_pL+1 3.14)
	  (setq ugol_pL-1 3.14)
	  )
	)
      )
    (setq t2 (list (+ (car krd) pl_vinoska_t3) (- (cadr krd) pl_vinoska_t3) 0))
    (command "_.MLEADER" krd t2 "text")
    (setq i (+ i stp))
    (setq my_mleader (entlast))
    (setq spis_mleader (entget my_mleader))
    (setq att_old (assoc 304 spis_mleader))
    (setq num_new (itoa i))
    (setq num_new (strcat pref num_new suff))
    (setq att_new (cons 304 num_new))
    (setq spis_mleader (subst att_new att_old spis_mleader))
    (entmod spis_mleader)
    (entupd (cdr (assoc -1 spis_mleader)))
    )
  ;последняя точка
  (if (/= (vlax-curve-getPointAtParam pln (+ j 1)) nil)
    (progn
      (setq j (1+ j))
      (setq krd (vlax-curve-getPointAtParam pln j))
      (setq t2 (list (+ (car krd) pl_vinoska_t3) (- (cadr krd) pl_vinoska_t3) 0))
      (command "_.MLEADER" krd t2  "text")
      (setq i (+ i stp))
      (setq my_mleader (entlast))
      (setq spis_mleader (entget my_mleader))
      (setq att_old (assoc 304 spis_mleader))
      (setq num_new (itoa i))
      (setq num_new (strcat pref num_new suff))
      (setq att_new (cons 304 num_new))
      (setq spis_mleader (subst att_new att_old spis_mleader))
      (entmod spis_mleader)
      (entupd (cdr (assoc -1 spis_mleader)))
      )
    ()
    )
  (princ)
  )

;_______________________________________________________________________________________________
(defun мв3 ( /  stp  krd t2  dis_p prm_pnt my_mleader spis_mleader att_old num_new att_new spis_mleader )
  (vl-load-com)  ; пикет
  (setvar "Osmode" 15359)  
  (setq j (- strPK 1))  
  (setq  dis_p  (- 0 rasst_pk ) )
  (while
    (progn
    (setq j (1+ j))
    (setq dis_p (+ dis_p rasst_pk  ))
    (setq krd (vlax-curve-getPointAtDist pln  dis_p ))
    )
    (setq t2 (list (+ (car krd) pl_vinoska_t2) (+ (cadr krd) pl_vinoska_t2) 0))    
    (setq prm_pnt  (vlax-curve-getParamAtPoint pln krd))
    (setq proiz (vlax-curve-getFirstDeriv pln prm_pnt))
    (setq ugol_pl (angle '(0 0 0) proiz))
    (setq ugol_pl_gr (* ugol_pl 57.29747))
    (setvar "attreq" 0)
    (if
      (not (tblsearch "block" pk_blok))
      (progn
	(block)
	(command "_.insert" pk_blok krd 1.0 1.0 ugol_pl_gr)
	)
      (command "_.insert" pk_blok krd 1.0 1.0 ugol_pl_gr); вставка блока
      )
    (command "_.MLEADER"
	     krd
	     t2
	      "text"
	     )
    (setq my_mleader (entlast))
    (setq spis_mleader (entget my_mleader))
    (setq att_old (assoc 304 spis_mleader))
    (setq num_new (strcat strPKk (itoa j)))
    (setq att_new (cons 304 num_new))
    (setq spis_mleader (subst att_new att_old spis_mleader))
    (entmod spis_mleader)
    (entupd (cdr (assoc -1 spis_mleader)))
    )
  (princ)
  )
;______________________________________________________________
(defun МТ1 ( / dis_pl x00 krd krd_text)
  (setvar "Osmode" 15359) ; название трубопровода
  (setq dis_pl (- 0 (/ rasst_pk 2)))  
  (while
    (progn
    (setq dis_pl (+ dis_pl rasst_pk))    
    (setq krd (vlax-curve-getPointAtDist pln dis_pl ))
    )
    (setq dis_pl_text (+ dis_pl 1))
    (setq krd_text (vlax-curve-getPointAtDist pln dis_pl_text))
    (command "_.mText" krd "_j" "_mc" "_w" ram_text Znach "")
    (vl-cmdf  "_.rotate"
	      "_last"
	      ""
	      "@"
	      krd_text
	      ""
	      )
    (command)
    (not (eq "MTEXT" (cdr (assoc 0 (setq x00 (entget  (entlast)))))))
    (or (assoc 441 x00) (entmod (append x00 '((90 . 3) (63 . 256) (45 . 1.0) (441 . 0)))))
    )
  )
;___________________________________________________________________
(defun мв9 ( / strt stp j num krd t2 i my_leader spis_mleader
	att_old	 num_new att_new )
  ; координаты точки
  (vl-load-com)
  (setq strt 1) ; ввод целого числа; -стартовый номер нумерации
  (setq stp 1) ; ввод целого числа; -шаг нумерации
  (setq j 0)
  (setq i (- strt stp))
 ; первая точка    
  (setq krd (vlax-curve-getPointAtParam pln j)) ; Вычисление точки на кривой по заданному значению параметра
; - точка вставки
  (setq t2 (list (+ (car krd) pl_vinoska_t3) (- (cadr krd) pl_vinoska_t3) 0)) ; точка вставки полки выноски
  (command "_.MLEADER" krd t2 "text")  
  (setq i (+ i stp))
  (setq my_mleader (entlast))
  (setq spis_mleader (entget my_mleader))
  (setq att_old (assoc 304 spis_mleader))
  (setq att_koor (assoc 110 spis_mleader))
  (setq num_new (strcat "Х=" (rtos (caddr  att_koor) 2 2) "\n Y=" (rtos (car (cdr att_koor)) 2 2))) 
  (setq att_new (cons 304 num_new))
  (setq spis_mleader (subst att_new att_old spis_mleader))
  (entmod spis_mleader)
  (entupd (cdr (assoc -1 spis_mleader)))
  (princ)
; следующие точки    
  (while (setq proiz+1 (vlax-curve-getPointAtParam pln (+ (+ j 1) 1)))
    (setq ugol_pL+1 0)
    (setq ugol_pL-1 3.14159)
    (while (= (rtos (abs (- ugol_pl-1 ugol_pl+1)) 2 5 ) (rtos pi 2 5 ))
      (setq j (1+ j))
      (setq krd (vlax-curve-getPointAtParam pln j))  
      (if (/= (vlax-curve-getPointAtParam pln (+ j 1)) nil)
	(progn
	  (setq proiz+1 (vlax-curve-getPointAtParam pln (+ j 1)))
	  (setq proiz-1 (vlax-curve-getPointAtParam pln (- j 1)))
	  (setq ugol_pL+1 (angle krd proiz+1))
	  (setq ugol_pL-1 (angle krd proiz-1))
	  )
	(progn
	  (setq ugol_pL+1 3.14)
	  (setq ugol_pL-1 3.14)
	  )
	)
      ) 
    (setq t2 (list (+ (car krd) pl_vinoska_t3) (- (cadr krd) pl_vinoska_t3) 0))
    (command "_.MLEADER" krd t2 "text")
    (setq i (+ i stp))
    ; Заполнение поля
   (setq my_mleader (entlast))
   (setq spis_mleader (entget my_mleader))
   (setq att_old (assoc 304 spis_mleader))
   (setq att_koor (assoc 110 spis_mleader))
   (setq num_new (strcat "Х=" (rtos (caddr  att_koor) 2 2) "\n Y=" (rtos (car (cdr att_koor)) 2 2))) 
   (setq att_new (cons 304 num_new))
   (setq spis_mleader (subst att_new att_old spis_mleader))
   (entmod spis_mleader)
  (entupd (cdr (assoc -1 spis_mleader)))
    )
  ;последняя точка
    (if (/= (vlax-curve-getPointAtParam pln (+ j 1)) nil)
      (progn
	(setq j (1+ j))
	(setq krd (vlax-curve-getPointAtParam pln j))
	(setq t2 (list (+ (car krd) pl_vinoska_t3) (- (cadr krd) pl_vinoska_t3) 0))
	(command "_.MLEADER" krd t2 "text")
	(setq i (+ i stp))
	(setq my_mleader (entlast))
	(setq spis_mleader (entget my_mleader))
	(setq att_old (assoc 304 spis_mleader))
	(setq att_koor (assoc 110 spis_mleader))
	(setq num_new (strcat "Х=" (rtos (caddr  att_koor) 2 2) "\n Y=" (rtos (car (cdr att_koor)) 2 2)))
	(setq att_new (cons 304 num_new))
	(setq spis_mleader (subst att_new att_old spis_mleader))
	(entmod spis_mleader)
	(entupd (cdr (assoc -1 spis_mleader)))
	)
      ()
      )
  (princ)
  )

;_________________________________________________________________

(defun К1 ( / snp    stp pref suff snp cmdh name_of_bl  krd t2 i num jj
		  dis_pl krd3 x00 dis_pl1 krd4 dlina my_mleader spis_mleader att_old num_new
		  att_new krdr1 krdr2 dis_p krd5 dis_pl2      krd_text  dis_pl_text t2)
  (setq snpp (getvar "insunits"))
  (setvar "insunits" 0)
  (setq stp 1) ; ввод целого числа; -шаг нумерации
  (setq pref "") ; ввод строки; -преффикс
  (setq suff "") ; ввод строки; -суффикс
  (setq snp (getvar "Osmode")) ; вывести значение переменной Osmode
  (setq cmdh (getvar "CMDECHO")) ; вывести значение переменной CMDECHO
  (setvar "Osmode" 15359) ; задать значение переменной Osmode
  (setvar "CMDECHO" 0) ; задать значение переменной CMDECHO
  (setq name_of_bl pk_blok_kol) ; имя блока
  (setq krd (vlax-curve-getPointAtParam pln 0)) ; Вычисление точки на кривой по заданному значению параметра
  (if
    (not (tblsearch "block" name_of_bl))
    (progn
      (block_kanaliz)
      (command "_.insert" name_of_bl krd 1.0 1.0 0) ; вставить блок
      )
    (command "_.insert" name_of_bl krd 1.0 1.0 0) ; вставить блок
    )
  (setq t2 (list (+ (car krd) m_koef) (+ (cadr krd) m_koef) 0)) ; задаем точку вставки
  (setq i (- strtrr stp))
  (setq i (+ i stp))
  (command "_.mText" T2 "_j" "_mc" "_w" ram_text i "") ; вставляем текст номер колодца
  (setq num (fix(-(vlax-curve-getEndParam pln) 1)))
  (setq jj 0)
  (setq jj (1+ jj))
  (setq dis_pl (/ (vlax-curve-getDistAtParam pln jj) 2))
  (setq krd3 (vlax-curve-getPointAtDist pln dis_pl))
  (setq dis_pl_text (+ dis_pl 1))
  (setq krd_text (vlax-curve-getPointAtDist pln dis_pl_text))
  (command "_.mText" krd3 "_j" "_mc" "_w" ram_textt  ZNACHen "") ; вставляем текст наименование трубы
  (vl-cmdf  "_.rotate"
	   "_last"
	  ""
	     "@"
            krd_text
	      ""
	    )
  (command)
  (while (not (eq "MTEXT" (cdr (assoc 0 (setq x00 (entget  (entlast))))))))
  (or (assoc 441 x00) (entmod (append x00 '((90 . 3) (63 . 256) (45 . 1.0) (441 . 0)))))
  (setq dis_pl1 (/ (vlax-curve-getDistAtParam pln jj) 3))
  (setq krd4 (vlax-curve-getPointAtDist pln dis_pl1))
  (setq t2 (list (+ (car krd4) pl_vinoska_t3) (- (cadr krd4) pl_vinoska_t3) 0))
  (setq dis_pl2  (/ (vlax-curve-getDistAtParam pln jj) m_koef) )
  (Setq dlina (rtos dis_pl2 2 1))
  (command "_.MLEADER"
	   krd4
	  t2  
	    "" 
  (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
	   ) ; вставляем мультивыноску с диаметром и длиной участка
  (setq my_mleader (entlast))
  (setq spis_mleader (entget my_mleader))
  (setq att_old (assoc 304 spis_mleader))
  (setq num_new (vl-string-subst "," "."  (strcat "%%C" diametr "\nL=" dlina "0" "м")))
  (setq att_new (cons 304 num_new))
  (setq spis_mleader (subst att_new att_old spis_mleader))
  (entmod spis_mleader)
  (entupd (cdr (assoc -1 spis_mleader)))
  (setq j 0)
  (repeat 1000
    (setq j (1+ j))
    (setq krd (vlax-curve-getPointAtParam pln j))
    (command "_.insert" name_of_bl krd 1.0 1.0 0) ; вставить блок
    (setq i (+ i stp)) ; увеличение переменной i на шаг нумерации
    (setq num_new (itoa i)) ; Преобразование целого числа в строковое представление
    (setq t2 (list (+ (car krd) m_koef) (+ (cadr krd) m_koef) 0)) ; задаем точку вставки
    (command "_.mText" T2 "_j" "_mc" "_w" ram_text num_new "") ; вставляем текст номер колодца
    (setq krdr1 (vlax-curve-getPointAtParam pln j))
    (setq jj (1+ j))
    (setq krdr2 (vlax-curve-getPointAtParam pln jj))
    (setq dis_p (/ (-  (vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) 2 ))
    (setq dis_pl (+ (vlax-curve-getDistAtParam pln j) dis_p))
    (setq krd3 (vlax-curve-getPointAtDist pln dis_pl))
    (setq dis_pl_text (+ dis_pl 1))
    (setq krd_text (vlax-curve-getPointAtDist pln dis_pl_text))
    (command "_.mText" krd3 "_j" "_mc" "_w" ram_textt  ZNACHen "") ; вставляем текст наименование трубы
    (vl-cmdf  "_.rotate"
	   "_last"
	  ""
	     "@"
                krd_text
	      ""
	    )
    (command)
    (while (not (eq "MTEXT" (cdr (assoc 0 (setq x00 (entget  (entlast))))))))
    (or (assoc 441 x00) (entmod (append x00 '((90 . 3) (63 . 256) (45 . 1.0) (441 . 0)))))
    (setq dis_p1 (/ (-  (vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) 3 ))
    (setq dis_pl1 (+ (vlax-curve-getDistAtParam pln j) dis_p1))
    (setq krd5 (vlax-curve-getPointAtDist pln dis_pl1))
    (setq t2 (list (+ (car krd5) pl_vinoska_t3) (- (cadr krd5) pl_vinoska_t3) 0))
    (setq dis_pl1  (/ (-(vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) m_koef) )
    (Setq dlina (rtos dis_pl1 2 1))
    (command "_.MLEADER"
	   krd5
	   t2 
	    "" 
  (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
	   ) ; вставляем мультивыноску с диаметром и длиной участка
    (setq my_mleader (entlast))
    (setq spis_mleader (entget my_mleader))
    (setq att_old (assoc 304 spis_mleader))
    (setq num_new (vl-string-subst "," "."  (strcat "%%C" diametr "\nL=" dlina "0" "м")))
    (setq att_new (cons 304 num_new))
    (setq spis_mleader (subst att_new att_old spis_mleader))
    (entmod spis_mleader)
    (entupd (cdr (assoc -1 spis_mleader)))
    );repeart
  (setq j (1+ j))
  (setq krd (vlax-curve-getPointAtParam pln (+ 1 num))) ; Вычисление точки на кривой по заданному значению параметра
  (command "_.insert" name_of_bl krd 1.0 1.0 0) ; вставить блок
  (setvar "Osmode"  snp) ; задать значение переменной Osmode, вернуть начальное значение через переменную snp
  (setvar "CMDECHO" cmdh) ; задать значение переменной CMDECHO, вернуть начальное значение через переменную cmdh
  ;(command "_.undo" "конец") ;отменить ; конец
  (setvar "insunits" snpp)
  )
;_________________________________________________________________
;Ручной режим
(defun К11 ( / snp    stp pref suff snp cmdh name_of_bl  krd t2 i num jj
		  dis_pl krd3 x00 dis_pl1 krd4 dlina my_mleader spis_mleader att_old num_new
		  att_new krdr1 krdr2 dis_p krd5 dis_pl2)
  (setq snpp (getvar "insunits"))
  (setvar "insunits" 0)
  (setq stp 1) ; ввод целого числа; -шаг нумерации
  (setq pref "") ; ввод строки; -преффикс
  (setq suff "") ; ввод строки; -суффикс
  ;(command "_.undo" "начало") ;отменить ; начало
  (setq snp (getvar "Osmode")) ; вывести значение переменной Osmode
  (setq cmdh (getvar "CMDECHO")) ; вывести значение переменной CMDECHO
  (setvar "Osmode" 15359) ; задать значение переменной Osmode
  (setvar "CMDECHO" 0) ; задать значение переменной CMDECHO
  (setq name_of_bl pk_blok_kol) ; имя блока
  (setq krd (vlax-curve-getPointAtParam pln 0)) ; Вычисление точки на кривой по заданному значению параметра
  (if
    (not (tblsearch "block" name_of_bl))
    (progn
      (block_kanaliz)
      (command "_.insert" name_of_bl krd 1.0 1.0 0) ; вставить блок
      )
    (command "_.insert" name_of_bl krd 1.0 1.0 0) ; вставить блок
    )
  (setq t2 (list (+ (car krd) pl_vinoska_t2) (+ (cadr krd) pl_vinoska_t2) 0)) ; задаем точку вставки
  (setq i (- strtrr stp))
  (setq i (+ i stp))
  (command "_.mText" T2 "_j" "_mc" "_w" ram_text i "") ; вставляем текст номер колодца
  (command "_.move" "_last" ""  "@")
  (command pause)
  (setq num (fix(-(vlax-curve-getEndParam pln) 1)))
  (setq jj 0)
  (setq jj (1+ jj))
  (setq dis_pl (/ (vlax-curve-getDistAtParam pln jj) 2))
  (setq krd3 (vlax-curve-getPointAtDist pln dis_pl))
  (command "_.mText" krd3 "_j" "_mc" "_w" ram_text  ZNACHen "") ; вставляем текст наименование трубы
  (vl-cmdf  "_.rotate"
	   "_last"
	  ""
	     "@"
	    )
  (command pause)
  (while (not (eq "MTEXT" (cdr (assoc 0 (setq x00 (entget  (entlast))))))))
  (or (assoc 441 x00) (entmod (append x00 '((90 . 3) (63 . 256) (45 . 1.0) (441 . 0)))))
  (setq dis_pl1 (/ (vlax-curve-getDistAtParam pln jj) 3))
  (setq krd4 (vlax-curve-getPointAtDist pln dis_pl1))
  (setq dis_pl2  (/ (vlax-curve-getDistAtParam pln jj) m_koef) )
  (Setq dlina (rtos dis_pl2 2 1))
  (command "_.MLEADER"
	   krd4
	   pause
	   ""
	   (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
	   ) ; вставляем мультивыноску с диаметром и длиной участка
  (setq my_mleader (entlast))
  (setq spis_mleader (entget my_mleader))
  (setq att_old (assoc 304 spis_mleader))
  (setq num_new (vl-string-subst "," "."  (strcat "%%C" diametr "\nL=" dlina "0" "м")))
  (setq att_new (cons 304 num_new))
  (setq spis_mleader (subst att_new att_old spis_mleader))
  (entmod spis_mleader)
  (entupd (cdr (assoc -1 spis_mleader)))
  (setq j 0)
  (repeat 1000
    (setq j (1+ j))
    (setq krd (vlax-curve-getPointAtParam pln j))
    (command "_.insert" name_of_bl krd 1.0 1.0 0) ; вставить блок
    (setq i (+ i stp)) ; увеличение переменной i на шаг нумерации
    (setq num_new (itoa i)) ; Преобразование целого числа в строковое представление
    (setq t2 (list (+ (car krd) pl_vinoska_t2) (+ (cadr krd) pl_vinoska_t2) 0)) ; задаем точку вставки
    (command "_.mText" T2 "_j" "_mc" "_w" ram_text num_new "") ; вставляем текст номер колодца
    (command "_.move" "_last" ""  "@")
    (command pause)
    (setq krdr1 (vlax-curve-getPointAtParam pln j))
    (setq jj (1+ j))
    (setq krdr2 (vlax-curve-getPointAtParam pln jj))
    (setq dis_p (/ (-  (vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) 2 ))
    (setq dis_pl (+ (vlax-curve-getDistAtParam pln j) dis_p))
    (setq krd3 (vlax-curve-getPointAtDist pln dis_pl))
    (command "_.mText" krd3 "_j" "_mc" "_w" ram_text  ZNACHen "") ; вставляем текст наименование трубы
    (vl-cmdf  "_.rotate"
	      "_last"
	      ""
	      "@"
	      )
    (command pause)
    (while (not (eq "MTEXT" (cdr (assoc 0 (setq x00 (entget  (entlast))))))))
    (or (assoc 441 x00) (entmod (append x00 '((90 . 3) (63 . 256) (45 . 1.0) (441 . 0)))))
    (setq dis_p1 (/ (-  (vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) 3 ))
    (setq dis_pl1 (+ (vlax-curve-getDistAtParam pln j) dis_p1))
    (setq krd5 (vlax-curve-getPointAtDist pln dis_pl1))
    (setq dis_pl1  (/ (-(vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) m_koef) )
    (Setq dlina (rtos dis_pl1 2 1))
    (command "_.MLEADER"
	     krd5
	     pause
	     ""
	     (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
	     ) ; вставляем мультивыноску с диаметром и длиной участка
    (setq my_mleader (entlast))
    (setq spis_mleader (entget my_mleader))
    (setq att_old (assoc 304 spis_mleader))
    (setq num_new (vl-string-subst "," "."  (strcat "%%C" diametr "\nL=" dlina "0" "м")))
    (setq att_new (cons 304 num_new))
    (setq spis_mleader (subst att_new att_old spis_mleader))
    (entmod spis_mleader)
    (entupd (cdr (assoc -1 spis_mleader)))
    );repeart
  (setq j (1+ j))
  (setq krd (vlax-curve-getPointAtParam pln (+ 1 num))) ; Вычисление точки на кривой по заданному значению параметра
  (command "_.insert" name_of_bl krd 1.0 1.0 0) ; вставить блок
  (setvar "Osmode"  snp) ; задать значение переменной Osmode, вернуть начальное значение через переменную snp
  (setvar "CMDECHO" cmdh) ; задать значение переменной CMDECHO, вернуть начальное значение через переменную cmdh
  ;(command "_.undo" "конец") ;отменить ; конец
  (setvar "insunits" snpp)
  )
;______________________________________________________________________
 (defun napor ( dcl_id / wathp) ;запуск панельки напорного трубопровода
   (if (not(new_dialog "np_tpos1" dcl_id)) (exit))
   (setq strPKk "ПК" )
   (setq strPK 0 )
   (setq strtr 1 )
   (setq strt 1 )
   (setq ZNACH "К1Н")
   (setq wathp 8)
   (while (< 2 wathp)
     (action_tile "kVyss" "(setq strPKk   $value)")
     (action_tile "kVys" "(setq strPK  (atoi $value))")
     (action_tile "kHbu" "(setq strtr (atoi $value))")
     (action_tile "kHbuk" "(setq strt (atoi $value))")
     (action_tile "kHbukkkk" "(setq ZNACH  $value)")
     (set_tile "kVyss" "ПК")
     (set_tile "kVys" "0")
     (set_tile "kHbu" "1")
     (set_tile "kHbuk" "1")
     (set_tile "kHbukkkk" "К1Н")
     (setq wathp (start_dialog))
     )
   )
;________________________________________________________________________
(defun samo ( dcl_id / wathpp) ;запуск панельки самотечного трубопровода
  (if (not(new_dialog "np_tpos2" dcl_id)) (exit))
  (setq diametr "160" )
  (setq strtrr 1 )  
  (setq ZNACHen "К1")
  (setq strt 1 )
  (setq AUTO "1")
  (setq wathpp 8)
  (while (< 2 wathpp )
    (action_tile "Diam" "(setq diametr $value)")
    (action_tile "KOLL" "(setq strtrr (atoi $value))")
    (action_tile "kHbuk" "(setq strt (atoi $value))")
    (action_tile "NAIMEN" "(setq ZNACHen $value)")
    (action_tile "AUTO" "(setq AUTO $value)")
    (set_tile "Diam" "160")
    (set_tile "KOLL" "1")    
    (set_tile "NAIMEN" "К1")
    (set_tile "kHbuk" "1")
    (setq wathpp (start_dialog))
    )
  )
;__________________________________________________________________
(defun VODO ( dcl_id / wathppp) ;запуск панельки городского водопровода
  (if (not(new_dialog "np_tpos3" dcl_id)) (exit))
  (setq diametr "100" )
  (setq strtrr 1 )
  (setq strtr 1)
  (setq ZNACHen "В1" )
  (setq wathppp 8)
  (while (< 2 wathppp )
    (action_tile "Diam" "(setq diametr $value)")
    (action_tile "KOLL" "(setq strtrr (atoi $value))")
    (action_tile "kHbu" "(setq strtr (atoi $value))")
    (action_tile "NAIMEN" "(setq ZNACHen $value)")    
    (set_tile "Diam" "100")
    (set_tile "KOLL" "1")
    (set_tile "kHbu" "1")
    (set_tile "NAIMEN" "В1")
    (setq wathppp (start_dialog))
    )
  )
;__________________________________________________________________________________________________________
(defun c:вернуть ( / )
  (command "_.undo" "_b")
  )
;________________________________________________________________________________________________________________
(defun block ( / )
  (vl-load-com) ; загружаем функции расширения 
  (setq acad_object (vlax-get-acad-object)); указатель на программу AutoCAD 
  (setq active_document (vla-get-activedocument acad_object)) ; указатель на активный документ 
  (setq model_space (vla-get-modelspace active_document))     ; указатель на пространство модели 
  (setq Dl (* 3 m_koef))
  (setq p1 (list 0.0 0.0 0.0))
  (setq p2 (list 0.0 ( * -1.5 m_koef) 0.0))
  (setq p3 (polar p2 (/ pi 2) Dl))
  (setq bl_name   "ПК_")
  (setq CСLAYER (getvar "CLAYER")) ;текущий слой
  ;(setvar "CLAYER" "Водопровод и канализация") ; сменить слой
  (setq snn (getvar "CELWEIGHT"))
  (setvar "CELWEIGHT" 70)
  (setq blk_kub (vla-add (vla-get-blocks active_document) (vlax-3d-point p1) bl_name))
  (vla-addline blk_kub (vlax-3d-point p2) (vlax-3d-point p3))
  (setvar "CLAYER" CСLAYER)
  (setvar "CELWEIGHT" snn)
  )
;__________________________________________________________________________________________________
(defun block_kanaliz ( / )
  (vl-load-com) ; загружаем функции расширения
  (setq acad_object (vlax-get-acad-object))                   ; указатель на программу AutoCAD
  (setq active_document (vla-get-activedocument acad_object)) ; указатель на активный документ
  (setq model_space (vla-get-modelspace active_document))     ; указатель на пространство модели
  (setq Dl (* 0.5 m_koef))
  (setq p1 (list 0.0 0.0 0.0))
  (setq p21 (polar p1 0.0 Dl))
  (setq p2 (polar p1 (/ pi 8) Dl))
  (setq p3 (polar p1 (/ pi 4) Dl))
  (setq p4 (polar p1 (+ (/ pi 4) (/ pi 8)) Dl))
  (setq p5 (polar p1 (/ pi 2) Dl))
  (setq p6 (polar p1 (+ (/ pi 2) (/ pi 8)) Dl))
  (setq p7 (polar p1 (+ (/ pi 2) (/ pi 4)) Dl))
  (setq p8 (polar p1 (+ (/ pi 2) (/ pi 4) (/ pi 8)) Dl))
  (setq p9 (polar p1  pi  Dl))
  (setq p10 (polar p1 (+ pi (/ pi 8)) Dl))
  (setq p11 (polar p1 (+ pi (/ pi 4)) Dl))
  (setq p12 (polar p1 (+ pi (/ pi 4) (/ pi 8)) Dl))
  (setq p13 (polar p1 (+ pi (/ pi 2)) Dl))
  (setq p14 (polar p1 (+ pi (/ pi 2) (/ pi 8)) Dl))
  (setq p15 (polar p1 (+ pi (/ pi 2) (/ pi 4)) Dl))
  (setq p16 (polar p1 (+ pi (/ pi 2) (/ pi 4) (/ pi 8)) Dl))
  (setq bl_name  "Kolodec_" )
  (setq CСLAYER (getvar "CLAYER")) ;текущий слой
  ;(setvar "CLAYER" "Водопровод и канализация") ; сменить слой
  (setq snn (getvar "CELWEIGHT"))
  (setvar "CELWEIGHT" 0)
  (command "_bedit" bl_name "")
  (command "_wipeout" p21 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 "")
  (setvar "CELWEIGHT" 70)
  (command "_circle" p1 Dl)
  (setvar "CLAYER" CСLAYER)
  (setvar "CELWEIGHT" snn)
  (command "_BCLOSE" "") 
  )
;_____________________________________________________________________________________________________

Кулик Алексей aka kpblc · 05.07.2016, 17:39

В AutoCAD 2009 command-s не существует.

Цитата:

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

Про Pi не совсем понял. Если можно поподробней.

Что за конструкция

Код:

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

 (setq ugol_pl-1 3.14159)
;; <...>
(setq ugol_pl+1 3.14)
(setq ugol_pl-1 3.14)

Дальше
За глобальное переопределение обработчика ошибок могут и побить. Возможно, даже ногами.
Количество глобальных переменных все еще зашкаливает.
Метки начала и конца отмены можно вполне легко ставить и без применения командных методов.
(vl-load-com) достаточно загружать только один раз.
Командными методами создавать мультивыноски чревато: http://autolisp.ru/2015/01/21/mleader_create_order/
В функции мв8 системная переменная osmode меняется и не восстаналивается. То же в мт1,
Функция создания блока, мягко говоря, вызывает массу вопросов. Что будет, если на момент ее вызова celtype будет нестандартная? Или слой не "0"? Вообще, посмотри понятие нормализвации блоков - на форуме темы были.
Самое главное - я положу lsp и dcl в абсолютно левый каталог, и программа перестанет работать.
P.S. Есть огромная тема "Научите лиспу на примере" - посмотри, там была масса информации.

jackUAROBEY · 11.08.2016, 15:38

Исправил ошибки загрузил по новой см. Начало темы

Код:

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

 
(progn  
  (princ " \nНаберите в командной строке:")	 
  (princ "\nТрасса - обрабатывает трассу ")
  (princ "\nвернуть - возвращает к исходному")
  )


;Сделать расстановка координат
;Сделать Выноску с диаметром напорного трубопровода


 
(vl-load-com)

(Defun c:Трасса ( / *error* acad_object active_document model_space file handle
		 CСLAYER snn snn_ snn_n snn_n_ snpp snp cmdh m_koef
		 dcl_id wath koordin trub flagok pln
		 strPKk strPK strtr      strt ZNACH
		 diametr      strtrr          ZNACHen AUTO
		 bl_name)
  
  (setq acad_object (vlax-get-acad-object))                   ; указатель на программу AutoCAD
  (setq active_document (vla-get-activedocument acad_object)) ; указатель на активный документ
  (setq model_space (vla-get-modelspace active_document))     ; указатель на пространство модели
  (vla-startUndoMark active_document)


(defun *error* (msg)  
  (vla-EndUndoMark active_document)
  (vla-sendcommand active_document "_.undo 1 ")
  (princ "\nВыход во время обработки данных\n")
  )
  
  (setq CСLAYER (getvar "CLAYER")) ;текущий слой
  (setq snn (getvar "CELWEIGHT")) ; вес линии
  (setq snn_ (getvar "CELTYPE"))
  (setq snn_n (getvar "CECOLOR"))
  (setq snn_n_ (getvar "CELTSCALE" ))
  (setq snpp (getvar "insunits")) ;ед изм вставки блока
  (setq snp (getvar "Osmode")) ; объектная привязка
  (setq cmdh (getvar "CMDECHO")) ; подсказки в функции Autolisp command 
  ;(setvar "CLAYER" "0")
  (setvar "CELWEIGHT" -1)
  (setvar "CELTYPE" "continuous")
  (setvar "CECOLOR" "bylayer")
  (setvar "CELTSCALE" 1.0)  
  (setvar "insunits" 0)
  (setvar "Osmode" 0)
  (setvar "CMDECHO" 0)  
  (setq m_koef 1) ;для М2-1 1 для М1-100 200  
  (setq file   (strcat (vl-string-right-trim
       "\\"
       (vla-get-tempfilepath
         (vla-get-files
           (vla-get-preferences (vlax-get-acad-object))
           ) ;_ end of vla-get-files
         ) ;_ end of vla-get-tempfilepath
       ) ;_ end of vl-string-right-trim
           "\\Трасса.dcl"
           ) ;_ end of strcat
  handle (open file "w")
  ) ;_ end of setq
  (foreach item
     '("np_tpos: dialog{label=\"Настройка комманды ТРАССА форум\";"
       ":spacer{height=1;}"
       ":text {label = \"Для корректной работы программы требуется настроенный стиль мультивыноски \";}"
       ":text {label = \"со значением параметра Максимумом точек выноски равным 2\";}"       
       ":spacer{height=1;}"
       ":text {label = \"Проверить направление полилинии при необходимости применить функцию Обратить \";}"
       ":spacer{height=1;}"
       ":row {"
       ":button{key = \"NAP\"; label = \"Введите данные для напорного трубопровода\";}"
       ":button{key = \"samot\"; label = \"Введите данные для самотечного трубопровода\";}}"
       ":radio_row{"
       ":radio_button {key = \"NAPorn\"; label = \"Напорный трубопровод\"; value = 1;}"
       ":radio_button {key = \"samotechn\"; label = \"Самотечный трубопровод\"; }}"
       ":spacer{height=3;}"
       ":boxed_column { label = \"Благие начинания, без финансовой поддержки умирают\";"
       ":text {label = \"Яндекс кошелек: 41001288968048 \";}}"
       "ok_cancel;"
       "}"
       "np_tpos1: dialog{label=\"Напорный трубопровод\";"
       ":text{label=\"ОПИСАНИЕ НАПОРНОГО КОЛЛЕКТОРА\"; alignment=centered;}"
       ":edit_box{label=\"ПК начала трассы (ПК, ПКК и т.д.)\";key=\"kVyss\";value=\"\";edit_width=6;}"
       ":edit_box{label=\"№ ПК начала трассы\";key=\"kVys\";value=\"\";edit_width=6;}"
       ":edit_box{label=\"Начальный № угла поворота\";key=\"kHbu\";value=\"\";edit_width=6;}"
       ;":edit_box{label=\"Начальный № точки координат\";key=\"kHbuk\";value=\"\";edit_width=6;}"
       ":edit_box{label=\"Наименование трубопровода\";key=\"kHbukkkk\";value=\"\"; edit_width=6;}"
       ":spacer{height=1;}"
       "ok_cancel;"
       "}"
       "np_tpos2: dialog{label=\"Самотечный трубопровод\";"
       ":text{label=\"ОПИСАНИЕ САМОТЕЧНОГО КОЛЛЕКТОРА\"; alignment=centered;}"
       ":edit_box{label=\"Диаметр трубопровода\";key=\"Diam\";value=\"\";edit_width=6;}"
       ":edit_box{label=\"Начальный № колодца\";key=\"KOLL\";value=\"\";edit_width=6;}"
       ;":edit_box{label=\"Начальный № точки координат\";key=\"kHbuk\";value=\"\";edit_width=6;}"
       ":edit_box{label=\"Наименование трубопровода\";key=\"NAIMEN\";value=\"\"; edit_width=6;}"
       ":toggle {label = \"Выполнить Авто\"; key=\"AUTO\"; value=\"1\";}"
       ":spacer{height=1;}"
       ":spacer{height=1;}"
       "ok_cancel;"
       "}"
       )
    (write-line item handle)
    ) ;_ end of foreach
  (close handle)  
  (setq dcl_id (load_dialog file))
  (if (not (new_dialog "np_tpos" dcl_id)) (exit))
  (action_tile "NAP" "(napor dcl_id)")
  (action_tile "samot" "(samo dcl_id)")  
  (setq trub "NAPorn")  
  (setq wath 8)
  (while (< 2 wath )    
    (action_tile "NAPorn" "(setq trub $key)")
    (action_tile "samotechn" "(setq trub $key)")    
    (setq wath (start_dialog))
    )  
  (unload_dialog dcl_id)  
  (setq pln (car (entsel"\nВыберите трассу:")))
  (if (= trub "NAPorn")
    (progn
      (МВ7) ; угол поворота
      (МВ3) ; пикет
      (МТ1) ; наименование трубопровода
      )
   (if (= trub "samotechn")
    (if (= AUTO "1") (к1) (к11)))
    )
  (setvar "CLAYER" CСLAYER)
  (setvar "CELWEIGHT" snn)
  (setvar "CELTYPE" snn_)
  (setvar "CECOLOR" snn_n)
  (setvar "CELTSCALE" snn_n_)
  (setvar "Osmode"  snp) ; задать значение переменной Osmode, вернуть начальное значение через переменную snp
  (setvar "CMDECHO" cmdh) ; задать значение переменной CMDECHO, вернуть начальное значение через переменную cmdh
  (setvar "insunits" snpp)
  (setvar "CELTSCALE" snn_n_)
  (vla-EndUndoMark active_document)
  (princ)
  )

;__________________________________________________________________________________
; НОМЕР УГЛА ПОВОРОТА
(defun мв7 ( / j krd t2 ugol_pL+1 ugol_pL-1 dis_pl dis_PK  my_leader att_old num_new )
 ; угол поворота пикет
  (setq j 0) ; номер вершины полилинии
  (setq strtr (- strtr 1)) ; номер угла поворота на выноске
  (while
    (setq proiz+1 (vlax-curve-getPointAtParam pln (+ (+ j 1) 1)))
    (setq ugol_pL+1 0)
    (setq ugol_pL-1 pi)
    (while (= (rtos (abs (- ugol_pl-1 ugol_pl+1)) 2 5 ) (rtos pi 2 5 ))
      (setq j (1+ j))    
      (setq krd (vlax-curve-getPointAtParam pln j))
      (if (/=  (vlax-curve-getPointAtParam pln (+ j 1)) nil)
	(progn	  
	  (setq ugol_pL+1 (angle krd
				 (vlax-curve-getPointAtParam pln (+ j 1))
				 )
		)
	  (setq ugol_pL-1 (angle krd
				 (vlax-curve-getPointAtParam pln (- j 1))
				 )
		)
	  )
	(progn
	  (setq ugol_pL+1 pi)
	  (setq ugol_pL-1 pi)
	  )
	);if
      )
    (setq ugol_pl+1 (if (> ugol_pl-1 ugol_pl+1)
		    (if (> pi (- ugol_pl-1 ugol_pl+1)) (- ugol_pl-1 ugol_pl+1) (+ (- (* 2 pi) ugol_pl-1) ugol_pl+1))
		    (if (> pi (- ugol_pl+1 ugol_pl-1))  (- ugol_pl+1 ugol_pl-1) (+ (- (* 2 pi) ugol_pl+1) ugol_pl-1))
		    )
	  )
    (setq  ugol_pl+1 (angtos  ugol_pl+1 1 2))
    (setq dis_pl (vlax-curve-getDistAtParam pln j))
    (setq dis_PK (itoa (+ strPK (fix (/ dis_pl ( * 100 m_koef ) )))))
    (setq dis_pl (vl-string-subst "," "." ( rtos (* (- (/ dis_pl ( * 100 m_koef ) ) (fix (/ dis_pl ( * 100 m_koef ) ))) 100) 2 1)))
    (setq t2 (list (+ (car krd) (* 5 m_koef )) (+ (cadr krd) (* 5 m_koef )) 0))
    (command "_.MLEADER" krd t2  ""
	     (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
	     )
    (setq my_mleader (entget (entlast)))
    (setq att_old (assoc 304 my_mleader))
    (setq num_new (itoa (+ strtr 1)))
    (setq num_new  (strcat "УП-" num_new " "  (vl-string-subst "%%d" "d" ugol_pl+1)  "\nПК" dis_pk  "+" dis_pl ))
    (setq num_new (cons 304 num_new))
    (setq my_mleader (subst num_new att_old my_mleader))
    (entmod my_mleader)
    (entupd (cdr (assoc -1 my_mleader)))
    )
  (setq j (1+ j))
  (setq krd (vlax-curve-getPointAtParam pln j))
  (setq dis_pl (vlax-curve-getDistAtParam pln j))
  (setq dis_PK (itoa (+ strPK (fix (/ dis_pl ( * 100 m_koef ) )))))
  (setq dis_pl (vl-string-subst "," "." ( rtos (* (- (/ dis_pl ( * 100 m_koef ) ) (fix (/ dis_pl ( * 100 m_koef ) ))) 100) 2 1)))
  (setq t2 (list (+ (car krd) (* 5 m_koef )) (+ (cadr krd) (* 5 m_koef )) 0))
  (if
    (/=  ( rtos (/ (vlax-curve-getDistAtParam pln j) ( * 100 m_koef )) 2 2)
	 ( rtos (fix (/ (vlax-curve-getDistAtParam pln j) ( * 100 m_koef ))) 2 2)
	 )
    (progn
      (command "_.MLEADER" krd t2  ""
	       (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
	       )
      (setq my_mleader (entget (entlast)))
      (setq att_old (assoc 304 my_mleader))
      (setq num_new (itoa (+ strtr 1)))
      (setq num_new  (strcat "ПК" dis_pk  "+" dis_pl ))
      (setq num_new (cons 304 num_new))
      (setq my_mleader (subst num_new att_old my_mleader))
      (entmod my_mleader)
      (entupd (cdr (assoc -1 my_mleader)))
      )
    ()
    )
  (princ)
  )
;_______________________________________________________________________________________________
; РАССТАНОВКА ПИКЕТОВ И НУМЕРАЦИЯ
(defun мв3 ( /  krd t2 dis_p ugol_pl my_mleader att_old num_new   )
    ; пикет
  (setq strPK (- strPK 1))  ;номер пикета
  (setq  dis_p  (- 0 ( * 100 m_koef ) ))
  (setq bl_name "ПК_")
  (while
    (progn
    (setq strPK (1+ strPK)) ;номер пикета
    (setq dis_p (+ dis_p ( * 100 m_koef )  )) ;расстояние до первого пикета
    (setq krd (vlax-curve-getPointAtDist pln  dis_p )) ;координата первого пикета
    )
    (setq t2 (list (+ (car krd) (* 5 m_koef )) (+ (cadr krd) (* 5 m_koef )) 0));координата полки мультивыноскивыноски
    (setq ugol_pl (* (angle '(0 0 0)
			    (vlax-curve-getFirstDeriv pln
			      (vlax-curve-getParamAtPoint pln krd)
			      )
			    )
		     57.29747
		     )
	  ); угол в градусах
    (if
      (not (tblsearch "block" bl_name))
      (progn
	(block)
	(command "_.insert" bl_name krd 1.0 1.0 ugol_pl)
	)
      (command "_.insert" bl_name krd 1.0 1.0 ugol_pl); вставка блока
      )
    (command "_.MLEADER" krd t2  ""
	     (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
	     )
    (setq my_mleader (entget (entlast)))
    (setq att_old (assoc 304 my_mleader))
    (setq num_new (cons 304
			(strcat strPKk (itoa strPK))
			)
	  )
    (setq my_mleader (subst num_new att_old my_mleader))
    (entmod my_mleader)
    (entupd (cdr (assoc -1 my_mleader)))
    )
  (princ)
  )
;______________________________________________________________
;НАЗВАНИЕ НАПОРНОГО ТРУБОПРОВОДА
(defun МТ1 ( / ram_ dis_pl krd krd_text)
  (setq dis_pl (- 0 (/ ( * 100 m_koef ) 2)))
  (setq ram_ (itoa (* 4 m_koef) ))
  (while
    (progn
      (setq dis_pl (+ dis_pl ( * 100 m_koef )))
      (setq krd (vlax-curve-getPointAtDist pln dis_pl ))
      )
    (setq krd_text (vlax-curve-getPointAtDist pln (1+ dis_pl)))
    
    (if
      (or
	(<=  (angle krd krd_text) (/ pi 2))
	(> (angle krd krd_text) (+ pi (/ pi 2)))
	)
      ()
      (setq krd_text (vlax-curve-getPointAtDist pln (- dis_pl 1)))
      )
    (command "_.mText" krd "_j" "_mc" "_w" ram_ Znach "")
    (command  "_.rotate" "_last" "" "@" krd_text "" )
    (command)
    (not (eq "MTEXT" (cdr (assoc 0 (setq krd_text (entget  (entlast)))))))
    (or (assoc 441 krd_text) (entmod (append krd_text '((90 . 3) (63 . 256) (45 . 1.0) (441 . 0)))))
    )
  (princ)
  )
;_________________________________________________________________
; САМОТЕЧНЫЙ ТРУБОПРОВОД автоматический режим
(defun К1 ( /  ram_  i jj j krd  t2  ram_ num dis_pl krd3 krd_text	   
	     x00  spis_mleader att_old num_new  att_new )
  (setq krd (vlax-curve-getPointAtParam pln 0)) ; Вычисление точки на кривой по заданному значению параметра
  (setq i (- strtrr 1)) ; номер колодца
  (setq j -1)
  (setq jj 0)
  (setq bl_name  "Kolodec_" )
   (while
    (progn
      (setq j (1+ j))
      (setq krd (vlax-curve-getPointAtParam pln j)) ; Вычисление точки на кривой по заданному значению параметра
      )
    (if
      (not (tblsearch "block" bl_name))
      (progn
	(block_kanaliz)
	(command "_.insert" bl_name krd 1.0 1.0 0) ; вставить блок
	)
      (command "_.insert" bl_name krd 1.0 1.0 0) ; вставить блок
      )
    (setq t2 (list (+ (car krd) (* 3 m_koef )) (+ (cadr krd) (* 3 m_koef )) 0)) ; задаем точку вставки
    (setq i (1+ i ))
    (setq ram_ (itoa  (* 4 m_koef))) ;рамка текста
    (command "_.mText" t2 "_j" "_mc" "_w" ram_ i "") ; номер колодца
    (if
      (/= nil
	 (vlax-curve-getPointAtParam pln (1+ j)) ; Вычисление точки на кривой по заданному значению параметра
	 )
      (progn
	(setq num (fix(-(vlax-curve-getEndParam pln) 1)))
	(setq jj (1+ j))
	(setq dis_pl ( + (vlax-curve-getDistAtParam pln j)
			 (/ (-  (vlax-curve-getDistAtParam pln jj)
				(vlax-curve-getDistAtParam pln j)) 2))
	      )
	(setq krd3 (vlax-curve-getPointAtDist pln dis_pl))
	(setq krd_text (vlax-curve-getPointAtDist pln (1+ dis_pl )))
	(if
	  (or
	    (<=  (angle krd3 krd_text) (/ pi 2))
	    (> (angle krd3 krd_text) (+ pi (/ pi 2)))
	    )
	  ()
	  (setq krd_text (vlax-curve-getPointAtDist pln (- dis_pl 1)))
	  )
	(setq ram_ (itoa (/ (* 4 m_koef)  2)))
	(command "_.mText" krd3 "_j" "_mc" "_w" ram_  ZNACHen "") ; вставляем текст наименование трубы
	(command "_.rotate" "_last" "" "@" krd_text "")
	(command)
	(while (not (eq "MTEXT" (cdr (assoc 0 (setq x00 (entget  (entlast))))))))
	(or (assoc 441 x00) (entmod (append x00 '((90 . 3) (63 . 256) (45 . 1.0) (441 . 0)))))
	(setq dis_pl ( + (vlax-curve-getDistAtParam pln j)    (/ (-  (vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) 3)))
	(setq krd3 (vlax-curve-getPointAtDist pln dis_pl))
	(setq t2 (list (+ (car krd3) (/ (* 10 m_koef ) 2)) (- (cadr krd3) (/ (* 10 m_koef ) 2)) 0))
	(Setq dis_pl (rtos (/ (-(vlax-curve-getDistAtParam pln jj)(vlax-curve-getDistAtParam pln j)) m_koef) 2 1))
	(command "_.MLEADER" krd3 t2  ""
		 (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
		 ) ; вставляем мультивыноску с диаметром и длиной участка
	(setq spis_mleader (entget (entlast)))
	(setq att_old (assoc 304 spis_mleader))
	(setq num_new (vl-string-subst "," "."  (strcat "%%C" diametr "\nL=" dis_pl "0" "м")))
	(setq att_new (cons 304 num_new))
	(setq spis_mleader (subst att_new att_old spis_mleader))
	(entmod spis_mleader)
	(entupd (cdr (assoc -1 spis_mleader)))
	)
      ()
      );if
    );while
  (princ)
  )
;_________________________________________________________________
;САМоТЕЧНЫЙ ТРУБОПРОВОД Ручной режим
(defun К11  ( /  ram_  i jj j  t2  ram_ num krd dis_pl krd3 krd_text	   
	     x00  spis_mleader att_old num_new  att_new )

  (setq stp 1) ; ввод целого числа; -шаг нумерации
  (setq i (- strtrr stp))
  (setq j -1)
  (setq jj 0)
  (setq bl_name  "Kolodec_" )  
  (while
    (progn
      (setq j (1+ j))
      (setq krd (vlax-curve-getPointAtParam pln j)) ; Вычисление точки на кривой по заданному значению параметра
      )   
  (if
    (not (tblsearch "block" bl_name))
    (progn
      (block_kanaliz)
      (command "_.insert" bl_name krd 1.0 1.0 0) ; вставить блок
      )
    (command "_.insert" bl_name krd 1.0 1.0 0) ; вставить блок
    )
  (setq t2 (list (+ (car krd) (* 3 m_koef )) (+ (cadr krd) (* 3 m_koef )) 0)) ; задаем точку вставки
  (setq i (+ i stp))
    (setq ram_ (itoa (* 4 m_koef)  ))
  (command "_.mText" T2 "_j" "_mc" "_w" ram_ i "") ; вставляем текст номер колодца
  (command "_.move" "_last" ""  "@")
  (command pause)
    (if
       (/= nil
	 (vlax-curve-getPointAtParam pln (1+ j)) ; Вычисление точки на кривой по заданному значению параметра
	 )
      (progn
	(setq num (fix(-(vlax-curve-getEndParam pln) 1)))
	(setq jj (1+ j))
	(setq dis_pl ( + (vlax-curve-getDistAtParam pln j)
			 (/ (-  (vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) 2)))
	(setq krd3 (vlax-curve-getPointAtDist pln dis_pl))
	(setq ram_ (itoa (/ (* 4 m_koef)  2)))
	(command "_.mText" krd3 "_j" "_mc" "_w" ram_  ZNACHen "") ; вставляем текст наименование трубы
	(command "_.rotate" "_last" ""	"@" )
	(command pause)
	(while (not (eq "MTEXT" (cdr (assoc 0 (setq x00 (entget  (entlast))))))))
	(or (assoc 441 x00) (entmod (append x00 '((90 . 3) (63 . 256) (45 . 1.0) (441 . 0)))))
	(setq dis_pl ( + (vlax-curve-getDistAtParam pln j)    (/ (-  (vlax-curve-getDistAtParam pln jj) (vlax-curve-getDistAtParam pln j)) 3)))
	(setq krd3 (vlax-curve-getPointAtDist pln dis_pl))
	(Setq dis_pl (rtos (/ (-(vlax-curve-getDistAtParam pln jj)(vlax-curve-getDistAtParam pln j)) m_koef) 2 1))
	(command "_.MLEADER" krd3 pause  ""
		 (vla-put-TextJustify (vlax-ename->vla-object(entlast)) 2)
		 ) ; вставляем мультивыноску с диаметром и длиной участка
	(setq spis_mleader (entget (entlast)))
	(setq att_old (assoc 304 spis_mleader))
	(setq num_new (vl-string-subst "," "."  (strcat "%%C" diametr "\nL=" dis_pl "0" "м")))
	(setq att_new (cons 304 num_new))
	(setq spis_mleader (subst att_new att_old spis_mleader))
	(entmod spis_mleader)
	(entupd (cdr (assoc -1 spis_mleader)))
	)
      ()
      );if
    );while
  (princ)
  )
;______________________________________________________________________
;запуск панельки напорного трубопровода
(defun napor ( dcl_id /  wathp) 
   (if (not(new_dialog "np_tpos1" dcl_id)) (exit))
   (setq strPKk "ПК" ); имя пикета
   (setq strPK 0 ); номер пикета
   (setq strtr 1 ); угол поворота
   (setq strt 1 ) ; номер точки координат
   (setq ZNACH "К1Н") ; наимен трубы
   (setq wathp 8)
   (while (< 2 wathp)
     (action_tile "kVyss" "(setq strPKk   $value)")
     (action_tile "kVys" "(setq strPK  (atoi $value))")
     (action_tile "kHbu" "(setq strtr (atoi $value))")
     (action_tile "kHbuk" "(setq strt (atoi $value))")
     (action_tile "kHbukkkk" "(setq ZNACH  $value)")
     (set_tile "kVyss" "ПК")
     (set_tile "kVys" "0")
     (set_tile "kHbu" "1")
     (set_tile "kHbuk" "1")
     (set_tile "kHbukkkk" "К1Н")
     (setq wathp (start_dialog))
     )
   (princ)
   )
;________________________________________________________________________
;запуск панельки самотечного трубопровода
(defun samo ( dcl_id / wathpp ) 
  (if (not(new_dialog "np_tpos2" dcl_id)) (exit))
  (setq diametr "160" ); диаметр трубы
  (setq strtrr 1 ) ;  номер колодца
  (setq ZNACHen "К1") ; наимен трубы
  (setq strt 1 ) ; номер точки координат
  (setq AUTO "1") ; режим авто
  (setq wathpp 8)
  (while (< 2 wathpp )
    (action_tile "Diam" "(setq diametr $value)")
    (action_tile "KOLL" "(setq strtrr (atoi $value))")
    (action_tile "kHbuk" "(setq strt (atoi $value))")
    (action_tile "NAIMEN" "(setq ZNACHen $value)")
    (action_tile "AUTO" "(setq AUTO $value)")
    (set_tile "Diam" "160")
    (set_tile "KOLL" "1")    
    (set_tile "NAIMEN" "К1")
    (set_tile "kHbuk" "1")
    (setq wathpp (start_dialog))
    )
  (princ)
  )
;________________________________________________________________________________________________________________
; Создание блока пикет
(defun block ( / Dl p1 p2 p3 bsnn bsnn_ bsnn_n bsnn_n_ blk_kub)
  (setq Dl (* 3 m_koef))
  (setq p1 (list 0.0 0.0 0.0))
  (setq p2 (list 0.0 ( * -1.5 m_koef) 0.0))
  (setq p3 (polar p2 (/ pi 2) Dl))
  (setq bl_name "ПК_")
  (setq bsnn (getvar "CELWEIGHT"))  
  (setq bsnn_ (getvar "CELTYPE"))  
  (setq bsnn_n (getvar "CECOLOR"))  
  (setq bsnn_n_ (getvar "CELTSCALE"))
  (setvar "CELWEIGHT" 70)
  (setvar "CELTYPE" "continuous")
  (setvar "CECOLOR" "bylayer")
  (setvar "CELTSCALE" 1.0)
  (setq blk_kub (vla-add (vla-get-blocks active_document) (vlax-3d-point p1) bl_name))
  (vla-addline blk_kub (vlax-3d-point p2) (vlax-3d-point p3))
  (setvar "CELWEIGHT" bsnn)
  (setvar "CELTYPE" bsnn_)
  (setvar "CECOLOR" bsnn_n)
  (setvar "CELTSCALE" bsnn_n_)
  (princ)
  )
;__________________________________________________________________________________________________
;Создание блока колодца
(defun block_kanaliz ( / Dl p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14
		      p15 p16 bsnn bsnn_ bsnn_n bsnn_n_ lst-obj)
  (setq Dl (* 0.5 m_koef))
  (setq p1 (list 0.0 0.0 0.0))
  (setq p21 (polar p1 0.0 Dl))
  (setq p2 (polar p1 (/ pi 8) Dl))
  (setq p3 (polar p1 (/ pi 4) Dl))
  (setq p4 (polar p1 (+ (/ pi 4) (/ pi 8)) Dl))
  (setq p5 (polar p1 (/ pi 2) Dl))
  (setq p6 (polar p1 (+ (/ pi 2) (/ pi 8)) Dl))
  (setq p7 (polar p1 (+ (/ pi 2) (/ pi 4)) Dl))
  (setq p8 (polar p1 (+ (/ pi 2) (/ pi 4) (/ pi 8)) Dl))
  (setq p9 (polar p1  pi  Dl))
  (setq p10 (polar p1 (+ pi (/ pi 8)) Dl))
  (setq p11 (polar p1 (+ pi (/ pi 4)) Dl))
  (setq p12 (polar p1 (+ pi (/ pi 4) (/ pi 8)) Dl))
  (setq p13 (polar p1 (+ pi (/ pi 2)) Dl))
  (setq p14 (polar p1 (+ pi (/ pi 2) (/ pi 8)) Dl))
  (setq p15 (polar p1 (+ pi (/ pi 2) (/ pi 4)) Dl))
  (setq p16 (polar p1 (+ pi (/ pi 2) (/ pi 4) (/ pi 8)) Dl))
  (setq bl_name  "Kolodec_" )
  (setq bsnn (getvar "CELWEIGHT"))  
  (setq bsnn_ (getvar "CELTYPE"))  
  (setq bsnn_n (getvar "CECOLOR"))  
  (setq bsnn_n_ (getvar "CELTSCALE"))
  (setvar "CELWEIGHT" 0)
  (setvar "CELTYPE" "continuous")
  (setvar "CECOLOR" "bylayer")
  (setvar "CELTSCALE" 1.0)  
  (setq blk_kub (vla-add (vla-get-blocks active_document) (vlax-3d-point p1) bl_name))  
  (command "_wipeout" p21 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 "")
  (setq lst-obj (cons (vlax-ename->vla-object (entlast)) nil))
  (vla-copyobjects
    active_document
    (vlax-make-variant
      (vlax-safearray-fill
	(vlax-make-safearray
	  vlax-vbobject
	  (cons 0 (1- (length lst-obj))))
	lst-obj)
      )
    blk_kub)
  (mapcar 'vla-erase lst-obj)
  (setvar "CELWEIGHT" 70)
  (vla-AddCircle  blk_kub  (vlax-3d-point p1) Dl)
  (setvar "CELWEIGHT" bsnn)
  (setvar "CELTYPE" bsnn_)
  (setvar "CECOLOR" bsnn_n)
  (setvar "CELTSCALE" bsnn_n_)
  (princ)
  )
;__________________________________________________________________________________________________________
(defun c:вернуть ( / )
  (command "_.undo" "_b")
  ;(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  )
;_____________________________________________________________________________________________________

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Расстановка номеров пикетов по трассе трубопровода.	Jeriko	AutoCAD	81	27.07.2015 21:04
Прокладка вутреннего водопровода и канализации	artifex	Водоснабжение и водоотведение	4	28.08.2014 09:13
Вопрос по построению профиля водопровода и канализации.	Анастасия26	Водоснабжение и водоотведение	3	24.01.2014 12:19