Re: Объём земляных работ
Добрый день. Хочется вот чего: Есть пример (DWG). Для вычисления разницы отметок использую этот LISP
(defun c:raz2 (/ ss el spmr delta att seqend a_name new_value att0 att)
;|
вычисляет разницу между проектными и существующими отметками
и вставляет её в блок otm01
|;
;;; ===========; считывание атрибутов в список ss ======================
(setq ss nil)
(while (null ss)
(setq ss (ssget '((0 . "INSERT") (2 . "OTM01"))
) ;_ конец ssget
) ;_ setq
) ;_ while
;;; (setq el (car (entsel "\nУкажите блок: ")))
;;; Цикл чтение АТРИБУТОВ
(setq i 0)
(if ss
(progn
(while (setq el (ssname ss i)) ; el - примитив
(setq att (entnext el))
(setq seqend (cdr (assoc 0 (entget att))))
;;; ; пока есть атрибуты в блоке
(while (not (eq seqend "SEQEND"))
;;; ; имя атрибута
(setq att_name (cdr (assoc 2 (entget att)))
att_value (cdr (assoc 1 (entget att))) ; значение
att_value (if (= att_value "")
"0"
att_value
) ;_ if
) ;_ setq
(cond
((= att_name "DELTA") (setq mar (list "DELTA" att_value)))
((= att_name "RED") (setq mar (list "RED" att_value)))
((= att_name "BLACK") (setq mar (list "BLACK" att_value)))
) ;_ cond
(setq spmr (cons mar spmr)
) ;_ конец setq
(setq att (entnext att)
att_value nil
) ;_ setq
(setq seqend (cdr (assoc 0 (entget att))))
) ;_ конец while
(setq delta (- (atof (car (cdr (assoc "RED" spmr))))
(atof (car (cdr (assoc "BLACK" spmr))))
) ;_ конец -
delta
;;; (vl-string-subst
;;; ","
;;; "."
(strcat (if (> delta 0)
"+"
""
) ;_ конец if
(rtos delta 2 2)
) ;_ конец strcat
;;; ) ;_ конец vl-string-subst
) ;_ конец setq
(nz_att_ch10 el (list (list "DELTA" delta)))
(setq i (1+ i))
) ;_ конец while
) ;_ конец progn
(prompt
"\n Блоков маркировки отметок земли - не найдено"
) ;_ конец prompt
) ;_ конец if
(princ)
) ;_ конец defun
;;; =================== ЗАМЕНА ЗНАЧЕНИЙ АТРИБУТОВ ========================================
(defun nz_att_ch10
(el_sp sp_atr / att seqend a_name new_value att0 att)
;;; el_sp - элемент списка
;;; new_value - новое значение
(setq att (entnext el_sp))
(setq seqend (cdr (assoc 0 (entget att))))
(while (not (eq seqend "SEQEND"))
; пока есть атрибуты в блоке
(setq a_name (cdr (assoc 2 (entget att)))) ; находим атрибут
;;; начинаем проверять по списку для изменений: есть - меняем
(setq new_value (car (cdr (assoc a_name sp_atr))))
(if new_value
(setq att0 (subst (cons 1 new_value)
(assoc 1 (entget att))
(entget att)
) ;_ конец subst
) ;_ конец setq
) ;_ конец if
(entmod att0)
(entupd att)
(setq att (entnext att))
(setq seqend (cdr (assoc 0 (entget att))))
) ;_ конец while
) ;_ конец defun Затем требуется вычислить объём фигуры (насыпь/выемка).
Хотелось бы использовать ЭТОТ LISP (или другой)
(DEFUN c:ob (/ I NABOR NN PLO SUMA TEXT OLD_DIM)
;|
вычисляет объем срезки\насыпи по разнице отметок и площаде фигуры
|;
(setq OLD_DIM (getvar "dimzin"))
(IF
(AND
(SETQ nabor (SSGET '((0 . "*text") (1 . "(*)") (62 . 5))))
(SETQ plo (ENTSEL "\nУчасток: "))
(SETQ plo (CAR plo))
(SETQ plo (VLA-GET-AREA (VLAX-ENAME->VLA-OBJECT plo)))
)
(PROGN
(SETQ nn (SSLENGTH nabor)
i -1
suma 0.0)
(REPEAT nn
(SETQ suma
(+
suma
(ATOF
(VL-STRING-TRIM
"()"
(CDR
(ASSOC
1
(ENTGET (SSNAME nabor (SETQ i (1+ i))))))))))
)
(SETQ suma (* (/ suma nn) plo))
(VL-CMDF "_.copy"
(SSNAME nabor 0)
""
"_none"
'(0 0 0)
"_none"
'(0 0 0))
(SETQ text (ENTGET (ENTLAST)))
(setvar "dimzin" 4)
(ENTMOD
(SUBST (CONS 1 (RTOS suma 2 2))
(ASSOC 1 text)
text))
(setvar "dimzin" OLD_DIM)
(VL-CMDF "_.change" "_l" "" "_p" "_co" 1 "")
(VL-CMDF "_.move"
"_l"
""
"_none"
(CDR (ASSOC 10 (ENTGET (ENTLAST))))
)
)
)
)чтоб значения брались из блока otm01 из атрибута DELTA путем выбора блоков, и выбора фигуры получался объём.
Т.е. вводишь команду -> выбираешь блоки (программа считывает значения из атрибута DELTA и вычисляет среднее) ->Enter -> выбираешь полилинию и получаешь объём насыпи или выемки в виде текста, который можно вставить.
Посмотрите, пожалуйста, можно ли такое реализовать?
