Высотные отметки

Высотные отметки · 15.08.2008, 14:03

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

файл чертежа для примера прилагается...

код проги

Кулик Алексей aka kpblc · 15.08.2008, 14:13

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

OHUKC · 15.08.2008, 14:21

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

Кулик Алексей aka kpblc · 15.08.2008, 14:30

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

OHUKC · 15.08.2008, 14:32

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

OHUKC · 15.08.2008, 14:35

(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 · 15.08.2008, 15:39

Цитата:

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

А в чем заключается "нормальность"

Обрати внимание на строчку в лиспе, который ты выложил:

Код:

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

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

OHUKC · 15.08.2008, 15:47

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

OHUKC · 15.08.2008, 15:55

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

Кутузов · 15.08.2008, 16:06

Зачем изобретать колесо, когда уже изобрели феррари

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

OHUKC · 15.08.2008, 16:15

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

Кутузов · 15.08.2008, 16:19

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

CB · 15.08.2008, 16:20

Цитата:

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

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

OHUKC · 15.08.2008, 16:26

я наверно не так сформулировал

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

Кутузов · 15.08.2008, 16:37

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

OHUKC · 15.08.2008, 16:43

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

CB · 15.08.2008, 17:02

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

OHUKC · 15.08.2008, 17:10

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

OHUKC · 15.08.2008, 17:26

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

CB · 15.08.2008, 18:10

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

или я опять не понял чего-то?

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

OHUKC · 15.08.2008, 19:44

НЕ .....надо чтоб только в начале запрашивало....вызвал команду...указал .что надо...проставил отметки с одной стороны фасада...завершил команду...затем вызвал заново ...указал что не надо и проставил с другой стороны фасада

)))

OHUKC · 18.08.2008, 14:05

есть фасад.нужно чтоб высотные отметки проставлялись как слева фасада , так и справа.по умолчанию они в данном коде отрисовываются всегда для проставления справа фасада.нужно , чтоб в начале спрашивало с какой стороны будут ставится высотные отметки: справа или слева фасада.если слева, то тогда зеркально отражать относительно оси Y.

CB · 18.08.2008, 21:20

Пробуй:

Код:

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

(defun C:level (/ hgt po pt pts tpt txt x *error* adoc msht dmz mirr)
  (defun *error* (msg)
    (princ msg)
    (vla-endundomark adoc)
    (setvar "DIMZIN" dmz)
  ) ;_ end of defun
  (vl-load-com)
  (setvar "PLINEWID" 0)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of vla-startundomark
  (setq dmz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (if (null *OLMSHT*)
    (setq *OLMSHT* 1)
  ) ;_ end of if
  (if
    (progn
      (initget "G K П Л _ П Л П Л")
      (= (getkword
    "\nСторона для вставки высотных отметок[Правая/Левая] :<Правая> "
  ) ;_ end of getkword
  "Л"
      ) ;_ end of =
    ) ;_ end of progn
     (setq mirr -1)
     (setq mirr 1)
  ) ;_ end of if
  (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))
  ) ;_ end of if
  (if (not (vl-string-search "." txt))
    (setq txt (strcat txt ".00"))
  ) ;_ end of if
  (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 (* mirr hgt 3.5) (* hgt 1.75) 0))
     ) ;_Horizont line
        tpt (mapcar '+ pt (list (* mirr hgt 1.75) (* hgt 2.0) 0))
  ) ;_ end of setq
  (entmakex (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))
     ) ;_ end of list
  ) ;_ end of entmake
  (entmakex
    (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)
     ) ;_ end of list
     (mapcar '(lambda (x) (cons 10 x))
      (mapcar '(lambda (x) (trans x 1 0)) pts)
     ) ;_ end of mapcar
    ) ;_ end of append
  ) ;_ end of entmake
  (vla-setwidth
    (vlax-ename->vla-object (entlast))
    0
    0.0
    (* hgt 2)
  ) ;_ end of vla-setwidth
  (entmakex (list '(0 . "TEXT")
    (cons 10 (trans tpt 1 0))
    (cons 11 (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)
    (cons 72 1)
     ) ;_ end of list
  ) ;_ end of entmake
       ) ;_ end of while
  ) ;_ end of and
  (setvar "DIMZIN" dmz)
  (vla-endundomark adoc)
  (princ)
) ;_ end of defun
(princ "\n >>> Insert levels Command: level")
(princ)

OHUKC · 19.08.2008, 10:13

СПАСИбО ОГРОМНОЕ

то что нужно

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Срезка голов свай до проектной отметки	tsman	Технология и организация строительства	29	28.06.2017 12:51
Блок отметки высоты на разрезе	Grinzaid	Динамические блоки	13	19.04.2008 12:58
Уровень планировочной отметки	Bracus	Архитектура	18	29.02.2008 13:44
Civil 3D 2008. Как повернуть проектные отметки на плане ?	Valery Brelovsky	Прочее. Отраслевые разделы	8	23.01.2008 12:05
Отметки высот	Халтурщик	AutoCAD	5	29.01.2007 15:58