[OHUKC]

Помогите пожалуйста довести до ума прогу ...нашёл на одном из форумов
http://www.caduser.ru/cgi-bin/f1/board.cgi?t=42685NX
Хотелось бы чтоб масштабировалось нормально...
и возможность прорисовки стрелки и простановки втекста высотной отметки в другую сторону
файл чертежа для примера прилагается...

код проги

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

Я файл не качал, поэтому совет может оказаться "впустую": на форуме рассматривались дин.блоки отметок...

[OHUKC]

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

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

Решается полем вкупе со смещением base (созданием ПСК)

[OHUKC]

если б я до такой степени в Lisp шарил

[OHUKC]

(defun C:level (/ hgt po pt pts tpt txt x *error* adoc msht dmz)
(defun *error* (msg)(princ msg)(vla-endundomark adoc)(setvar "DIMZIN" dmz))
(vl-load-com)(setvar "PLINEWID" 0)
(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(setq dmz (getvar "DIMZIN"))(setvar "DIMZIN" 0)
(if (null *OLMSHT*)(setq *OLMSHT* 1))
(and (or (initget 6 "1 10 20 50 100 1000") t)
(princ "\nscale [1/10/20/50/100/500/1000] <")
(princ *OLMSHT*)(princ ">: ")
(or (setq msht (getdist))(setq msht *OLMSHT*))
(setq *OLMSHT* msht)(or (vl-propagate '*OLMSHT*) t)
(setq msht (/ msht 100.0))
(setq po (getpoint "\nSpecify o.oo point: "))
(setq hgt (getvar "TEXTSIZE"))
(while (setq pt (getpoint "\nSpecify next point (Enter for esc):"))
(setq txt (rtos (setq pts (* msht (- (cadr pt)(cadr po)))) 2 2))
(if (and (not (minusp pts))(not (zerop pts)))
(setq txt (strcat "+" txt)))
(if (not (vl-string-search "." txt))(setq txt (strcat txt ".00")))
(setq pts (list pt
(mapcar '+ pt (list 0 (* hgt 0.6) 0)) ;_hgt of arrow
(mapcar '+ pt (list 0 (* hgt 1.75) 0));_Vert line
(mapcar '+ pt (list (* hgt 3.5) (* hgt 1.75) 0)));_Horizont line
tpt (mapcar '+ pt (list 0 (* hgt 2.0) 0)))
(entmake (list
'(0 . "LINE")
'(100 . "AcDbEntity")
(cons 410 (getvar "CTAB"))
(cons 8 (getvar "CLAYER"))
'(100 . "AcDbLine")
(cons 62 256)
(cons 10 (trans (polar pt PI (* hgt 0.9)) 1 0))
(cons 11 (trans (polar pt 0 (* hgt 0.9)) 1 0))
))
(entmake (append (list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
(cons 410 (getvar "CTAB"))
(cons 8 (getvar "CLAYER"))
'(100 . "AcDbPolyline")
(cons 62 256)
(cons 90 (length pts))
(cons 70 0)
(cons 43 0.0))
(mapcar '(lambda (x) (cons 10 x))(mapcar '(lambda(x)(trans x 1 0)) pts)))
)
(vla-setwidth (vlax-ename->vla-object (entlast)) 0 0.0 (* hgt 2))
(entmake (list '(0 . "TEXT")
(cons 10 (trans tpt 1 0))
(cons 410 (getvar "CTAB"))
(cons 8 (getvar "CLAYER"))
(cons 7 (getvar "TEXTSTYLE"))
(cons 62 256)
(cons 40 hgt)
(cons 50 0.0)
(cons 1 txt)
)
)
)
)
(setvar "DIMZIN" dmz)(vla-endundomark adoc)
(princ)
)
(princ "\n >>> Insert levels Command: level")
(princ)

[CB]

Хотелось бы чтоб масштабировалось нормально...

А в чем заключается "нормальность"
Обрати внимание на строчку в лиспе, который ты выложил:

Код:

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

.............................................................................
(setq *OLMSHT* msht)(or (vl-propagate '*OLMSHT*) t)
(setq msht (/ msht 100.0))
(setq po (getpoint "\nSpecify o.oo point: "))
.............................................................................

[OHUKC]

а что эта строчка делает???

[OHUKC]

а не подскажешь как в код забить масштабирование высотной отметки???
т.е. чтоб она выводилась не маленькая а например раз в 100 по размеру больше????

[Кутузов]

Зачем изобретать колесо, когда уже изобрели феррари? Надстройка к акад называется СПДС GraрhiCS. Отметки, выноски, размеры, разрезы и все такое под любой масштаб в соответствии с ГОСТ по СПДС... или я не понимаю чего-то. Может это хобби такое c лиспом заморачиваться? Времени свободного вагон?

[OHUKC]

он поверх автокада ставится ...как приложение????

[Кутузов]

Сначала автокад, потом СПДС-ка сверху. Только заходить через ярлык СПДС.
А я думал уже все этой штукой пользуются...

[CB]

а что эта строчка делает???

Эта строчка как раз и уменьшает значения высотных отметок в 100 раз.

[OHUKC]

я наверно не так сформулировал
нужно чтоб не ЗНАЧЕНИЕ менялось...
а само ИЗОБРАЖЕНИЕ высотной отметки на чертеже было больше...
тут по ходу прямо в коде рисуется высотная отметка....
нельзя ли её больше по размеру сделать?????

[Кутузов]

Можно. В правом нижнем углу есть окошко масштаба. Или не окошко, а маленькая кнопочка. На нее кликни, выбери масштаб. После этого ставь отметку. Ее размер будет соответствовать выбранному масштабу. Имеется в виду масштаб чертежа, в котором будешь печатать.

[OHUKC]

хотелось бы чтоб в проге это было

[CB]

Я не зря я спросил в <<чем заключается "нормальность>>...
Ну а по делу - дело в следующем
За размеры изображения отвечает значение системной переменной "textsize".
Какую высоту текста ты хочешь иметь, такое и назначь ей значение:
например (setvar 'textsize 40)

[OHUKC]

то что надо....СПАСИБО...
а как програмно поменять , чтоб зеркально отображалось????...
и какойнить запрос типа "отобразить зеркально? (Y/N)"

[OHUKC]

чтоб отметки можно было ставить и справа и слева фасада

[CB]

Вообще-то сделать наверно не сложно, НО если тебе надо поставить, к примеру 100 отметок, все 100 раз будет мелькать <<какойнить запрос типа "отобразить зеркально? (Y/N)">> ??? или я опять не понял чего-то?

Ну и что такое <зеркально> - отразить можно относительно оси X или Y. Короче давай картинку что должно получитья при выборе "отразить зеркально"