[Grinzaid]

Написал я лиспик, выставляющий высоты на разрезе (с возможностью учёта абс. нуля). Всё отлично работает. А вот при изменеиии разреза или абс. нуля приходится всё сызнова проставлять.

Как бы мне "приказать" всем атривутам имениться на новое значение координаты Y точки вставки блока (естественно с поправкой на введённые денные ±0.00 и абс. нуля )?

Прога работает с блоком "mif", содержащим 2 текстовых и 2 численных атрибута (по одной паре на 100-ый и 50-ый масштабы). Жаль, что не могу DWG прицепить.

Код:

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

;Input automaticaly section level in block "mif".
;Disigned by Vlad Grinzaid
;6.3.2002
;Defining relative & absolute 0.00
(defun c:00 ()
	(setq relativxy (getpoint "\Pick a relative 0.00: "))
	(setq absoluty (getreal "\Enter an absolute 0.00 value: "))	
	(setq relativy (nth 1 relativxy))
	
(command "ATTREQ" "1" "")

);end defun 00

;Insert Level
(defun c:IL ()
(command "dimzin" "0" "")
	(setq inspointxy (getpoint "\Pick an insertion point of level: "))
	(setq inspointy (nth 1 inspointxy))
	(setq relvalue (/ (- inspointy relativy) 100))
	(setq relvalue2 (rtos relvalue 2 2))
;	(setq absvalue (+ relvalue absoluty))

	(cond
		((> relvalue 0) 

(setq relvalue3 (strcat "+" relvalue2))
(command "dimzin" "0" "")
(command "-insert" "mif" inspointxy "1" "1" "0" relvalue3 " " relvalue3 " ")
(command "dimzin" "8" "")
		)

		((= relvalue 0) 
(setq relvalue3 (strcat "±" relvalue2))
(command "dimzin" "0" "")
(command "-insert" "mif" inspointxy "1" "1" "0" relvalue3 " " relvalue3 " ")
(command "dimzin" "8" "")
		)

		((< relvalue 0) 
(command "dimzin" "0" "")
(command "-insert" "mif" inspointxy "1" "1" "0" relvalue2 " " relvalue2 " ")
(command "dimzin" "8" "")
		)
	);cond
);end defun IL

(defun c:AB ()
(command "dimzin" "0" "")
	(setq inspointxy (getpoint "\Pick an insertion point of level: "))
	(setq inspointy (nth 1 inspointxy))
	(setq relvalue (/ (- inspointy relativy) 100))
	(setq relvalue2 (rtos relvalue 2 2))
	(setq absvalue (rtos (+ relvalue absoluty) 2 2))


(cond
		((> relvalue 0) 

(setq bothlevels (strcat "+" relvalue2 "=" absvalue))
(command "dimzin" "0" "")
(command "-insert" "mif" inspointxy "1" "1" "0" bothlevels " " bothlevels " ")
(command "dimzin" "8" "")
		)

		((= relvalue 0) 
(setq bothlevels (strcat "±" relvalue2 "=" absvalue))
(command "dimzin" "0" "")
(command "-insert" "mif" inspointxy "1" "1" "0" bothlevels " " bothlevels " ")
(command "dimzin" "8" "")
		)

		((< relvalue 0) 
(setq bothlevels (strcat relvalue2 "=" absvalue))
(command "dimzin" "0" "")
(command "-insert" "mif" inspointxy "1" "1" "0" bothlevels " " bothlevels " ")
(command "dimzin" "8" "")
		)
	);cond

);end defun AB

Допоможите, мудрейшие.

[Grinzaid]

P.S.
Пытался я эту проблему решить при помощи Dimension / Ordinate, предварительно разработав стиль, однако это работало только над ±0.00, т.к. Ordinate не ведает отриц. значений и вычисляет лишь модуль.

[vk]

В общем виде алгоритм правки такой:
- указать новый "ноль"
- указать вставку (INSERT) или вставки блока для обновления (как вариант - автоматом выбрать все вставки блока с определенным именем)
- определить координату Y точки вставки (caddr (assoc 10 ins))
- прочитать значения атрибутов (для каждого), а они находятся сразу за INSERT'ом
(setq att (entget (entnext ins)))
(cdr (assoc 1 attr))
- вычислить новые значения
- модифицировать значения атрибутов (entmod (subst (cons 1 <новое_значение>) (assoc 1 attr) attr))

Приблизительно так.

[Startrek]

А ты попробуй значение абсолютного нуля засадить на VARIABLE и пусть прога
ее читает и поступает соответственно, у меня просто нет времени писать
а попробовать надо. Вообще-то я стараюсь все засадить на VARIABLE а потом прога их читает
а если какие изменения то менять надо только в одном месте
И то что VK предложил очень хорошо.

[Arkady]

Код:

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

  (defun dxf (code elist / ret)
    (cond
      ( (= (type elist) 'LIST) (setq ret (cdr (assoc code elist))) )
      ( (= (type elist) 'ENAME) (setq ret (cdr (assoc code (entget elist)))) )
      (T (setq ret nil))
    )
    ret
  )

  (defun putdxf (code value elist / ret)
    (cond
      ( (= (type elist) 'LIST)  (setq ret elist))
      ( (= (type elist) 'ENAME) (setq ret (entget elist)))
      (T (setq ret nil))
    )
    (if ret (progn
      (if (assoc code ret) 
          (setq ret (subst (cons code value) (assoc code ret) ret))
          (setq ret (append ret (list (cons code value))))
      )
    ))
    ret
  )


(defun c:00 () 
   (setq relativxy (getpoint "\Pick a relative 0.00: ")) 
   (setq absoluty (getreal "\Enter an absolute 0.00 value: "))    
   (setq relativy (nth 1 relativxy))     
   (setvar "ATTREQ" 1)  
);end defun 00 


(defun c:Show00()
   (setq osmode (getvar "osmode"))
   (setvar "osmode" 0)
   (command "LINE" relativxy "@100,0" "")
   (command "LINE" relativxy "@0,50" "")
   (command "TEXT" relativxy "1" "0" (rtos absoluty))
   (setvar "osmode" osmode)
   (princ)  
  )

;Insert Level 
(defun c:IL ()
  (if (not relativy)(c:00))
   (Setvar "dimzin" 0) 
   (setq inspointxy (getpoint "\Pick an insertion point of level: "))
 (if inspointxy (progn  
   (setq inspointy (nth 1 inspointxy)) 
   (setq relvalue (/ (- inspointy relativy) 100)) 
   (setq relvalue2 (rtos relvalue 2 2)) 
   ;(setq absvalue (+ relvalue absoluty)) 

   (cond 
      ((> relvalue 0) 
        (setq relvalue3 (strcat "+" relvalue2)) 
      ) 
      ((= relvalue 0) 
       (setq relvalue3 (strcat "±" relvalue2)) 
      ) 
      ((< relvalue 0)
        (setq relvalue3 relvalue2)
      )    
   );cond
   (Setvar "dimzin" 0)  
   (command "-insert" "mif" inspointxy "1" "1" "0" relvalue3 " " relvalue3 " ") 
   (Setvar "dimzin" 8) 
 )) ;; End if and progn
 (princ)  
);end defun IL 

(defun c:AB ()
    (if (not relativy)(c:00))
   (setvar "dimzin" 0) 
   (setq inspointxy (getpoint "\Pick an insertion point of level: "))
(if inspointxy (progn
   (setq inspointy (nth 1 inspointxy)) 
   (setq relvalue (/ (- inspointy relativy) 100)) 
   (setq relvalue2 (rtos relvalue 2 2)) 
   (setq absvalue (rtos (+ relvalue absoluty) 2 2)) 
   (cond 
      ((> relvalue 0) 
       (setq bothlevels (strcat "+" relvalue2 "=" absvalue)) 
      )
      ((= relvalue 0) 
       (setq bothlevels (strcat "±" relvalue2 "=" absvalue)) 
      )
      ((< relvalue 0) 
       (setq bothlevels (strcat relvalue2 "=" absvalue)) 
      ) 
   );cond
   (setvar "dimzin" 0) 
   (command "-insert" "mif" inspointxy "1" "1" "0" bothlevels " " bothlevels " ") 
   (setvar "dimzin" 8)
)) ;; end if and progn   
(princ)

);end defun AB

(defun c:MifUpdate()
    (if (not relativy)(c:00))
    (setq ssl (ssget (list (cons 2 "MIF"))))
    (if (not ssl)(progn
	(alert "Can't find MIF Blocks")	   
	(exit)
    ))
    (setq ll (sslength ssl))
    (setq no 0)
    (repeat ll
      (setq bl (ssname ssl no))
      (setq no (1+ no))
      (setq atr1 (entnext bl))
      (setq atr2 (entnext atr1))
      (setq atr3 (entnext atr2))
      
      (setq inspointxy (dxf 10 bl))
      (setq inspointy (nth 1 inspointxy)) 
      (setq relvalue (/ (- inspointy relativy) 100)) 
      (setq relvalue2 (rtos relvalue 2 2)) 
      (setq absvalue (rtos (+ relvalue absoluty) 2 2))
      (cond 
         ((> relvalue 0) 
           (setq relvalue3 (strcat "+" relvalue2)) 
         ) 
         ((= relvalue 0) 
          (setq relvalue3 (strcat "±" relvalue2)) 
         ) 
         ((< relvalue 0)
           (setq relvalue3 relvalue2)
         )    
      );cond
      
      ;; This is IL or Absolut Variant - Search "=" in attribyte string
      
      (if (ifabs (dxf 1 atr1))
	  (setq relvalue3 (strcat relvalue3 "=" absvalue)) 
	)
      (setq ed (putdxf 1 relvalue3 atr1))
      (entmod ed)      
      (setq ed (putdxf 1 relvalue3 atr3))
      (entmod ed)
      (entmod (entget bl))
      (entupd bl)
      ) ;; end of repeat
  (princ)
  )

(defun ifabs (str / ll no   retval)
    (setq retval nil)
    (setq ll (strlen str))
    (setq no 1)
    (repeat ll
      (if (= (substr str no 1) "=")
	(setq retval T)
	)
      (setq no (1+ no))
     ) 
  retval
  )

[vk]

Делал в свое время аналогичную программку (без коррекции). Лежит на http://vkle.bazarov.net/otm.zip

Поправил адрес размещения программы.

[Grinzaid]

Аркадий, гениальная штука получилась, огромное спасибо!

[Perezz!!]

А как бы вот такое осуществить:
дано: dtext
нужно: посчитать сумму выделенных строк. Строки представляют из себя исключительно числовые значения, разделённые запятой. Например:
12,4
3,9
6,5
175,8
30,2
Строки выделяются не последовательно, а выборочно, например:
3,9; 175,8; 30,2
:?:

[vk]

Если по простому и без "защиты от дурака", то можно так:

Код:

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

;;; Сумма чисел в строках текста
(defun c:sumtxt (/ ss n sum)
  (setq ss  (ssget '((0 . "TEXT")))
        n   0
        sum 0
  ) ;_  setq
  (repeat (sslength ss)
    (setq sum (+ sum (atof (vl-string-subst "." "," (cdr (assoc 1 (entget (ssname ss n)))))))
          n   (1+ n)
    ) ;_  setq
  ) ;_  repeat
  (princ "\nСумма = ")
  (princ sum)
  (princ)
) ;_  defun
(vl-load-com)

Добавил недостающую строку, чтобы был "тихий" выход.

[Perezz!!]

Как то глючено всё это. И текст мне нужно стирать! Достаточно просто вывести значение суммы в коммандной строке.

[vk]

>Perezz!!
Какой текст? Откуда стирать? Если можно, подробнее, плз.
Могу только предположить, что была активна команда отрисовки текста, то она ченить творит....

[Perezz!!]

Опечатка вышла, прошу пардонить!

И текст мне не нужно стирать!

[Grinzaid]

Аркадий, простите за назойливость, но как бы сделать так, чтобы отметки, имеющие только относительное значение, оставались только относительными после update?

[Grinzaid]

Аркадий, простите, это я напортачил при копировании LSP. Всё работает. Осталась лишь одна тонкость: всегда писать с точностью до сотых, деже если выходит круглое значение. Т.е. при расстановке отметок это так и работает, а при update - нет. Надо бы (rtos relvalue3 2 2) куда-то вклинить, но что-то я напутал. Подсобите, а? :roll:

[Arkady]

Влад здравствуйте.
С rtos играться не надо.
Просто вставьте строку (Setvar "dimzin" 0) в начало функции c:MifUpdate