[RЯков]

Доброго вечера!
Я конечно понимаю что на дворе 2012 год и все уважающие себя проектировщики закупили себе крутой софт и строчат многокилометровые профиля за минуты. Однако, случается и такое когда софта нет и нет возможности его установить..., да и материал приходится иногда просто исправлять, что несмотря на автоматизацию быстрее сделать чем построить новый профиль в геониксе. Ну в общем то это все присказка т.к. много искал похожую тему в поиске но не нашел.

Задача следующая: У отрезка в свойствах есть значение дельта х и дельта у, так вот как бы мне нажать на кнопочку на панельке(раз), указать отрезок(два), а там сосчитается формула дельта у / (дельта х * 5 ), разместить в нужном мне месте текст текущего стиля( три)... ну как то так вот...
Спасибо!

[gomer]

Возможно, сойдет и подобная байда

Код:

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

 (defun c:LA2T (/ en bp el pt10 pt11)
  (if (and (setq en (entsel))
	   (setq bp (getpoint))
      )
    (progn

      (setq el	 (entget (car en))
	    pt10 (cdr (assoc 10 el))
	    pt11 (cdr (assoc 11 el))
      )
      (command "_text" bp 2.5 0 (rtos (/ (- (cadr pt10) (cadr pt11)  ) (* 5 (- (car pt10) (car pt11)  ))) 2 4) "")
    )
  )
)

[VVA]

Мой вариант

Код:

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

(defun c:TANGENS (/ en el pt10 pt11)
  (and
     (setq ss (ssget "_:L:S:E" '((0 . "LINE"))))
     (setq el (entget(ssname ss 0))
 	    pt10 (cdr (assoc 10 el))
	    pt11 (cdr (assoc 11 el))
           )
    (setq en
       (ru-text-entmake
         (rtos(/(-(cadr pt10)(cadr pt11))(* 5(-(car pt10)(car pt11))))2 4)
         '(0 0 0)
         (getvar "TEXTSIZE")
         0
         nil
         )
      )
     (command "_.copybase" (trans '(0 0 0) 0 1) en "" "_.erase" en "" "_.pasteclip" "_none" pause)
      )
  )
(defun ru-text-entmake (txt pnt height rotation justification / ent_list)
  ;;;ShaggyDoc
  ;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276
  (setq   ent_list (list   '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(100 . "AcDbText")
      (list 10 (car pnt) (cadr pnt) 0.0)
      (cons 1 txt)
      (cons 40 height)
      ;;(cons 7 "RU_CAD")
      (if justification
        (cond
          ((= justification "C")
           '(72 . 1)
          )
          ((= justification "R")
           '(72 . 2)
          )
          ((= justification "A")
           '(72 . 3)
          )
          ((= justification "M")
           '(72 . 4)
          )
          ((= justification "F")
           '(72 . 5)
          )
          (t
           '(72 . 0)
          )
        ) ;_ end of cond
        '(72 . 0)
      ) ;_ end of if
      (cons 50 rotation)
      (list 11 (car pnt) (cadr pnt) 0.0)
     ) ;_ end of list
   ) ;_ end of setq
   (entmakex ent_list)
)

[Дима_]

Offtop: 2Gomer - bp не локализирован.

[VVA]

Еще один вариант. Запрашивает уровень для отрисовки текста (графа профиля) и в цикле выбор отрезков

Код:

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

(defun c:TANGENS1 (/ en el pt10 pt11 PTtext)
  (and
     (progn
       (initget 7)
       (setq pttext (getpoint "\nУровень для отрисовки текста: "))
       )
     (princ "\nВыберите отрезок <выход> :")
     (while
       (setq ss (ssget "_:L:S:E" '((0 . "LINE"))))
       (setq el (entget(ssname ss 0))
 	    pt10 (cdr (assoc 10 el))
	    pt11 (cdr (assoc 11 el))
           )
       (setq en
        (ru-text-entmake
         (rtos(/(-(cadr pt10)(cadr pt11))(* 5(-(car pt10)(car pt11))))2 4)
         (list (car(mapcar '+ pt10(mapcar '*(mapcar '- pt11 pt10)(list 0.5 0.5 0.5))))(cadr pttext))
         (getvar "TEXTSIZE")
         0
         "M"
         )
      )
     (princ "\nВыберите отрезок <выход> :")
      )
     )
  (princ)
  )
(defun ru-text-entmake (txt pnt height rotation justification / ent_list)
  ;;;ShaggyDoc
  ;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276
  (setq   ent_list (list   '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(100 . "AcDbText")
      (list 10 (car pnt) (cadr pnt) 0.0)
      (cons 1 txt)
      (cons 40 height)
      ;;(cons 7 "RU_CAD")
      (if justification
        (cond
          ((= justification "C")
           '(72 . 1)
          )
          ((= justification "R")
           '(72 . 2)
          )
          ((= justification "A")
           '(72 . 3)
          )
          ((= justification "M")
           '(72 . 4)
          )
          ((= justification "F")
           '(72 . 5)
          )
          (t
           '(72 . 0)
          )
        ) ;_ end of cond
        '(72 . 0)
      ) ;_ end of if
      (cons 50 rotation)
      (list 11 (car pnt) (cadr pnt) 0.0)
     ) ;_ end of list
   ) ;_ end of setq
   (entmakex ent_list)
)

[RЯков]

Спасибо!

[gomer]

Сообщение от Дима_ bp не локализирован

ну, я ж написал, что "байда"

[Олег (jr.)]

для интересу, кому нать

Код:

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

(defun C:demo  (/ code data dx dy elist loop p1 p2 pt res)
  (defun dxf (key alist)
  (cdr (assoc key alist))
  )
  (setq loop T)
  (while loop
    (setq code (grread T 2))
    (if
      (and
	(= 5 (car code))
	(setq data (nentselp "\nОбозначить отрезок: " (cadr code)))
	(eq "LINE"
	    (cdr (assoc 0 (setq elist (entget (car data)))))
	)
      )
       (progn
	 (setq p1 (dxf 10 elist))
	 (setq p2 (dxf 11 elist))
	 (setq dy (- (cadr p2) (cadr p1)))
	 (setq dx (- (car p2) (car p1)))
	 (setq res (rtos (/ dy (* dx 5.)) 2 3))
	 ;;; debug only:
;;;	 (alert
;;;	   (strcat "Delta Y: "
;;;		   (rtos dy 2 3)
;;;		   "\nDelta X: "
;;;		   (rtos dx 2 3)
;;;		   "\nResult: " res
;;;		   
;;;	   )
;;;	 )
	 (setvar "dimzin" 0)
	 (setq pt (getpoint "\nТочка вставки текста: "))
	 (if (zerop (cdr (assoc 40 (entget (tblobjname "style" (getvar "textstyle"))))))
	   (command "text" "_J" "MC" "_non" pt "" "0" res)
	   (command "text" "_J" "MC" "_non" pt "0" res)
	 )
	 (setq loop nil)
       )

    )
  )
  (command)
  (princ)
  )