Тема: Программа пересчета текста в AutoCAD,help

Привет.
Имеются программки для пересчета текста (высотные отмеки):
автор Кулик Алексей aka kpblc (2006-11-21 14:11:38)
(defun c:chtxt (/ adoc delta selset)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (if (and (setq delta (getreal "\nВведите разность значений <ВЫход> : "))
           (setq selset (ssget '((0 . "*TEXT"))))
           ) ;_ end of and
    (foreach ent (mapcar 'vlax-ename->vla-object
                         (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                         ) ;_ end of mapcar
      (if ((lambda (/ res)
             (mapcar '(lambda (x)
                        (if (vl-string-search x (vla-get-textstring ent))
                          (setq res t)
                          ) ;_ end of if
                        ) ;_ end of lambda
                     '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "," ".")
                     ) ;_ end of mapcar
             res
             ) ;_ end of lambda
           )
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-textstring
               ent
               (rtos
                 (+ (atof (vl-string-translate "," "." (vla-get-textstring ent)))
                    delta
                    ) ;_ end of +
                 ) ;_ end of rtos
               ) ;_ end of vla-put-TextString
             ) ;_ end of lambda
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
___________________________________________________________
автор Провинциал (2006-11-21 14:36:29)
(defun c:Pik_up(/)
(setvar "cmdecho" 0)
(setq plius (getreal "\nЗадайте приращение по высотке в виде ###.## : "));
(setq e (ssget "x" '((-4 . "<AND")(0 . "text")(8 . "annotation")(-4 . "AND>") )))
(if (/= e nil)(progn
(while (/= (sslength e) 0)
(setq enn (ssname e 0))
(if (/= enn nil)(progn
(setq edata(entget enn))
(setq cto(cdr(assoc 1 edata)))
(setq sd(rtos (+ plius (atof cto)) 2 2))
(setq cto(cdr(assoc 1 edata)))
(setq avod (cons 1 cto))
(setq avid (cons 1 sd))
(setq edata (subst avid avod edata))
(entmod edata)
(setq e(ssdel enn e))
)))))
(princ)
)
__________________________________________________________
автор Провинциал (2006-11-21 14:36:29)
(defun c:text-vo ( / )
(setq z_!(getreal "\nЗадайте приращение по Z в виде zzz.zz : "))
(setq iln_$(getstring "\nВведите имя слоя с текстами высотных отметок:"))
(setq nabor_L (ssget "X" (list(cons 0 "TEXT")(cons 8 iln_$))))
(if nabor_L
(progn
(setq nabor_%(sslength nabor_L) ne_% 0)
(setvar "CMDECHO" 0)
(command "_-layer" "_m" (strcat iln_$ "_new") "")
(command "_-style" "" "" "0" "" "" "" "" "")
(repeat nabor_%
(setq name(ssname nabor_L ne_%) ent_L(entget name)
v1(cdr(assoc '10 ent_L)) h1_!(cdr(assoc '40 ent_L))
r_!(* 180(/(cdr(assoc '50 ent_L))pi))
txt_$(rtos(+(atof(cdr(assoc '1 ent_L)))z_!) 2 2)
);setq
(command "_text" v1 h1_! r_! txt_$ "")
(setq ne_%(1+ ne_%))
);repeat
);progn
(print (strcat "На слое " iln_$ " нет текстов sad"))
);if nabor_L
(setvar "CMDECHO" 1)
(prin1)
);c:text-vo
все они по своему хороши, но хотелось бы модернизировать )
исходный текстовый слой - annotation
исходный текст - 12 Ug_Zdan 123.120, 13 Urez -1.452,
14 Zabor 56.562, 15 Dor_Os 15.450 и т.д.
требуется:
пересчитанные (после ввода дельты) отметки отображаются в новом слое, кол-во знаков после запятой 2, реализована функция Select objects:(chtxt Кулик Алексей)
пример: после ввода дельты  +10.20( в исходном слое), в созданном слое Rabochiy обработано:133.12, 8.75, 66.76, 25.65 и т.д.
Господа помогите пожалуйста!

Re: Программа пересчета текста в AutoCAD,help

Держи приятель ))):

(defun c:del_ta(/)

(setvar "cmdecho" 0)

(setq plius (getreal "\nЗадайте дельту в виде ###.## : "))

;- - - - - - - - - - - - - - - - - - - - - -удаляет коды с отрицательной высоткой и "пустые тексты"

(vl-cmdf "_.erase"
                         ;(cond ((ssget "_X" '((0 . "TEXT,MTEXT") (-4 . "<not") (1 . "*[~\040]*") (-4 . "not>"))

(cond ((ssget "_X" '((0 . "TEXT,MTEXT") (-4 . "<and") (8 . "work_h") (1 . "*-*") (-4 . "and>"))
                    )
                   )
                   (t "_non")
             )
(cond ((ssget "_X" '((0 . "TEXT,MTEXT") (-4 . "<not") (1 . "*[~\040]*") (-4 . "not>"))
)
                   )
                   (t "_non")
             )

             ""
    )
;- - - - - - - - - - - - - - - - - - - - - -конец удаления

(setq e (ssget "x" '((-4 . "<AND")(0 . "text")(8 . "work_h")(-4 . "AND>") )))

(if (/= e nil)

(progn
(while (/= (sslength e) 0)
(setq enn (ssname e 0))

(if (/= enn nil)

(progn

(setq edata(entget enn))

(setq cto(cdr(assoc 1 edata)))

;(setq kol_el(strlen cto)); количество элементов в строке

(setq nom_p(vl-string-search " " cto)); позиция первого разделителя

;_______________________________________________если отметки уже пересчитаны   12.33
(if (= nom_p nil)

        (progn

(setq sd(rtos (+ plius (atof cto)) 2 2))

(setq cto(cdr(assoc 1 edata)))

(setq avod (cons 1 cto))

(setq avid (cons 1 sd))

(setq edata (subst avid avod edata))

(entmod edata)

(setq e(ssdel enn e))
                      ); конец прогн

;____________________________________________________________если еще коды после sokkia      23 Zabor 126.230

(progn

(setq posl_p(vl-string-position (ascii " ") (vl-string-right-trim " " cto) nil t)); posl_p - номер позиции последнего разделителя

(setq qwer(atof(substr cto (+ 1 (vl-string-search " " cto posl_p)))))

(setq sd(rtos (+ plius qwer) 2 2)); число знаков после запятой

(setq cto(cdr(assoc 1 edata)))

(setq avod (cons 1 cto))

(setq avid (cons 1 sd))

(setq edata (subst avid avod edata))

(entmod edata)

(setq e(ssdel enn e))
                            ); конец прогн
                                              ); конец моего if

)))))

(princ)

)


Пересчет высот (тахеометр Sokkia)
Создаем новый слой work_h, переносим (копируем) туда требуемый пересчета текст. Команда del_ta.