[ivan]

Ищу программу по простановке знака шероховатости по ГОСТ 2.309-73* с изменением 3. Знак шероховатости ставится под полкой.

[getr]

Ищи в Download'е прогу ASymbol,автор Бабийчук.Она много чего делает в том числе и шероховатость над и под полкой.

[fixo]

Спробуй

Код:

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

(defun c:sher (/ cosa l p p1 p2 p3 ptl px sina txt w)
  (while
  (setq p (getpoint "\nУказать точку вставки : "))
  (progn
  (setq l (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))
	cosa (cos (/ pi 3))
	sina (sin (/ pi 3)))
  (if (zerop l)(setq l (getvar "dimtxt")))
  (setq txt (getstring T "\nВвести текст : ")
	w (* (strlen txt) l 0.9375)
	p1 (list (- (car p) (/ (* l cosa) sina))(+ (cadr p) l))
	p2 (list (+ (car p) (/ (* l cosa 2) sina))(+ (cadr p) (* l 2)))
	p3 (list (+ (car p2) w)(cadr p2))
	px (list (+ (car p2)(/ w 2))(cadr p2))
	px (list (car px)(- (cadr px)(/ l 2)))
	ptl (list p1 p p2 p3)
  )
  
(entmake
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(8 . "0")
'(100 . "AcDbPolyline")
(cons 370 9)
(cons 90 (length ptl))
(cons 70 0)
(cons 43 0.0)
)
(mapcar (function (lambda (x) (cons 10 x))) ptl)
)
)
  
(entmake
(list (cons 0 "TEXT") 
(cons 10 px) 
(cons 11 px) 
(cons 1 txt) 
(cons 7 (getvar "TEXTSTYLE")) 
(cons 40 (getvar "DIMTXT"))
(cons 72 0)
(cons 72 1)
(cons 73 3)) 
)
  )
  )
(princ)
)
(prompt
    "\n\t\t\t  I==========================================I\n"
  )
(prompt
    "\n\t\t\t  I  ДЛЯ ВЫПОЛНЕНИЯ ПРОГРАММЫ НАБРАТЬ: sher  I\n"
  )
(prompt
    "\n\t\t\t  I==========================================I\n"
  )

~'J'~

[SUG]

и как , что с этим делать
вообщем как из вышеприведённого получить знак шероховатости

[fixo]

Сообщение от SUG и как , что с этим делать вообщем как из вышеприведённого получить знак шероховатости

Тогда тебе рекомендую хорошенько изучить для начала:
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=19612AN

~'J'~

[Кулик Алексей aka kpblc]

ИМХО - лучше сюда - это будет проще

[Cnapmak]

Программок простановки шероховатости масса, но все-же (как и отклонения размеров) лучше MechaniCS не видел.

[vn]

Господа корифеи!
Подправьте программку шероховатости.
См.прикрепленный файл. И еще высоту шрифта умножьте на 06 и в Arial ,please/

(defun c:sher (/ cosa l p p1 p2 p3 ptl px sina txt w)
(while
(setq p (getpoint "\nУказать точку вставки : "))
(progn
(setq l (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))
cosa (cos (/ pi 3))
sina (sin (/ pi 3)))
(if (zerop l)(setq l (getvar "dimtxt")))
(setq txt (getstring T "\nВвести текст : ")
w (* (strlen txt) l 0.9375)
p1 (list (- (car p) (/ (* l cosa) sina))(+ (cadr p) l))
p2 (list (+ (car p) (/ (* l cosa 2) sina))(+ (cadr p) (* l 2)))
p3 (list (+ (car p2) w)(cadr p2))
px (list (+ (car p2)(/ w 2))(cadr p2))
px (list (car px)(- (cadr px)(/ l 2)))
ptl (list p1 p p2 p3)
)

(entmake
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(8 . "0")
'(100 . "AcDbPolyline")
(cons 370 9)
(cons 90 (length ptl))
(cons 70 0)
(cons 43 0.0)
)
(mapcar (function (lambda (x) (cons 10 x))) ptl)
)
)

(entmake
(list (cons 0 "TEXT")
(cons 10 px)
(cons 11 px)
(cons 1 txt)
(cons 7 (getvar "TEXTSTYLE"))
(cons 40 (getvar "DIMTXT"))
(cons 72 0)
(cons 72 1)
(cons 73 3))
)
)
)
(princ)
)
(prompt
"\n\t\t\t I==========================================I\n"
)
(prompt
"\n\t\t\t I ДЛЯ ВЫПОЛНЕНИЯ ПРОГРАММЫ НАБРАТЬ: sher I\n"
)
(prompt
"\n\t\t\t I==========================================I\n"
)
[ATTACH]1151958292.dwg[/ATTACH]