Как сделать выноски пикетажа в вершины полилинии.

Leher27 · 16.01.2012, 12:42

Уважаемые корифеи!!! Задача следующая: имеется полилиния (ось трассы КЛ). Необходимо создать выноски пикетажа в вершинах этой полилинии (в поворотных точках трассы). Находил лиспик для создания пикетажа, но там необходимо каждый раз кликать по полилинии для простановки выносок. А мне нужно,что бы пикетаж проставлялся в вершины сразу по клику по полилинии. Сам программировать на лиспе пока не умею, хотя планирую освоить. Умею только пользоваться готовыми программами (прошу не хихикать, многие и этого не могут). Если есть такой лисп, буду благодарен очень.

Дима_ · 16.01.2012, 13:01

Тебе еще осталось научиться пользоваться поиском и размещать темы в соответствующих разделах. Программ таких немеренно.

Leher27 · 16.01.2012, 13:08

хоть бы ссылочку кинул, чем умничать-то просто...

Дима_ · 16.01.2012, 13:25

А Вас в Google уже забанили чтоли?

Leher27 · 16.01.2012, 13:30

Я повторюсь, лиспы для нанесения пикетажа я нашёл, но они работают не так , как хотелось бы. Мне нужны отметки пикетажа в ВЕРШИНАХ полилинии, которые проставлялись бы автоматически, то есть по клику по полилинии.

Олег (jr.) · 16.01.2012, 20:53

Цитата:

Сообщение от Leher27

Я повторюсь, лиспы для нанесения пикетажа я нашёл, но они работают не так , как хотелось бы. Мне нужны отметки пикетажа в ВЕРШИНАХ полилинии, которые проставлялись бы автоматически, то есть по клику по полилинии.

Давай чертеж с примером

Leher27 · 17.01.2012, 08:39

Вот кусочек трассы. В вершинах полилинии хочу проставить отметки пикетажа.

Олег (jr.) · 17.01.2012, 13:40

Цитата:

Сообщение от Leher27

Вот кусочек трассы. В вершинах полилинии хочу проставить отметки пикетажа.

Не смог воспроизвести такой алгоритм расстановки
у меня получается большее число пикетов
Пробуй

Код:

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

 (defun C:PiKet(/ *error* acsp adoc appd attd blk clay maxp minp n pl  sset)
  
  (defun *error* (msg)
    (cond (adoc (vla-endundomark adoc)))
    (cond
      ((not msg))
      ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
      (T (princ (strcat "\nError: " msg)))
    )    
    (if attd (setvar "ATTDIA" attd))
    (if clay (setvar "clayer" clay))
    (princ)
  )

  
  (or adoc
      (setq adoc
	     (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
      )
  )
  (or appd (setq appd (vla-get-application adoc)))
  (or acsp
      (setq acsp
	     (vla-get-block
	       (vla-get-activelayout adoc)
	     )
      )
  )

 (vla-endundomark adoc)
(vla-startundomark adoc)
(if (setq sset (ssget "+.:S:L" '((0 . "*POLYLINE"))))
  (progn
    
 (setq pl (vlax-ename->vla-object (ssname sset 0)))
	       (vla-getboundingbox pl 'minp 'maxp)
    
      (vla-zoomwindow appd minp maxp )
	 (setq n 0)
	(setq attd (getvar "attdia"))
      (setvar "attdia" 0)
  	(setq clay (getvar "clayer"))
        (setvar "clayer" "Ось трассы")
	(while (< n (vlax-curve-getendparam pl))
      (setq blk (vlax-invoke  acsp 'insertblock 
					  (vlax-curve-getclosestpointto pl (vlax-curve-getpointatparam pl n))
		  "KL"
					     1. 1. 1. 0.))

	  (foreach attrib (vlax-invoke blk 'getAttributes)
          (if
            (eq (strcase (vla-get-tagstring attrib)) "НОМЕР")
    
              (vla-put-textstring attrib (itoa (+ n 1)))
              
            )
          )
      
	  (setq n (1+ n))
	  )
  )
 )
 (*error* nil)
	(princ)
	 )
(prompt "\n")
(prompt "\n	***	Старт команда: \"Piket\"	*** \n")
(prin1)
(vl-load-com)
(princ)

Leher27 · 17.01.2012, 15:04

Вот такую ошибку выдает после запуска команды: "Error: неверная строка режима ssget"

Олег (jr.) · 17.01.2012, 16:23

замени у тебя видимо локальный Автокад

Код:

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

(setq sset (ssget "_:S" '((0 . "LWPOLYLINE"))))

Leher27 · 17.01.2012, 17:08

Спасибо конечно,тоже полезная прога,но мне хотелось что бы в вершинах полилинии проставились отметки пикетажа, т.е. например ПК:1+28.9, ПК:2+76.5 и т.д. (числа указаны ради премера просто). Смысл в том, чтобы программа сама размечала полилинию через каждые 100м, а затем в каждой вершине полилинии проставляла выноску такого формата, как я указал выше.

Олег (jr.) · 17.01.2012, 20:01

Цитата:

Сообщение от Leher27

Спасибо конечно,тоже полезная прога,но мне хотелось что бы в вершинах полилинии проставились отметки пикетажа, т.е. например ПК:1+28.9, ПК:2+76.5 и т.д. (числа указаны ради премера просто). Смысл в том, чтобы программа сама размечала полилинию через каждые 100м, а затем в каждой вершине полилинии проставляла выноску такого формата, как я указал выше.

Тогда какого х.а ты прислал другой файл
тебя же по-русски просили прислать чертеж с примером
я ведь тоже убил на это свое время а не с потолка брал

Leher27 · 18.01.2012, 08:36

Извиняюсь...Думал,ты просил пример трассы...

Олег (jr.) · 18.01.2012, 14:12

Это другое дело
Опять же в программе не воспроизвести куда
надо вставлять, придется указывать точки вручную и
затем указывать только приблизительное
направление точки вставки текста выноски
Имя команды Pikets

Код:

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

 (defun C:PiKets(/ *error* acsp  adoc appd cec clay clt dimp dimz dist ept flag 
		ldobj leg mpt mtx  ort osm pl prec spt sset textheight txtpt)
  
  (defun *error* (msg)
    (cond (adoc (vla-endundomark adoc)))
    (cond
      ((not msg))
      ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
      (T (princ (strcat "\nError: " msg)))
    )    
    (if osm (setvar "osmode" osm))
    (if dimz (setvar "dimzin" dimz))
    (if ort (setvar "orthomode" ort))
    (if clay (setvar "clayer" clay))
    (if cec (setvar "cecolor" cec))
    (if clt (setvar "celtype" clt))
    (princ)
  )
; Convert value in degrees to radians
(defun dtr (a)
  (* pi (/ a 180.0))
) 
  ; Convert value in radians to degrees
(defun rtd (a)
  (* 180.0 (/ a pi))
)
  (if (not (tblsearch "style" "СПДС"))
  (progn  (alert "Стиль текста \"СПДС\" не существует - создать!")
    (exit)(princ)))
  (or adoc
      (setq adoc
	     (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
      )
  )
  (or appd (setq appd (vla-get-application adoc)))
  (or acsp
      (setq acsp
	     (vla-get-block
	       (vla-get-activelayout adoc)
	     )
      )
  )

 (vla-endundomark adoc)
(vla-startundomark adoc)
  	(setq osm (getvar "osmode"))
      (setvar "osmode" 1)
  
(if (not (tblsearch "layer" "Пикеты")) 
(command "_.-layer" "m" "Пикеты" "c" "1" "Пикеты" "lt" "Continuous" "Пикеты" "lw" "0.30" "Пикеты" ""))
  
(if (setq sset (ssget "_:S" '((0 . "LWPOLYLINE")(8 . "Ось трассы"))))
  (progn
    
 (setq pl (vlax-ename->vla-object (ssname sset 0)))
;;;     ;расскомметировать если надо для блоков
;;;	(setq attd (getvar "attdia"))
;;;        (setvar "attdia" 0)
 
  	  (setq clay (getvar "clayer"))
           (setvar "clayer" "Пикеты")
 	  (setq cec (getvar "cecolor"))
           (setvar "cecolor" "bylayer")
          (setq clt (getvar "celtype"))
           (setvar "celtype" "bylayer")
 (setq textheight 1.5);<-- высота текста
 (setq prec 1);<--  точность
(setq dimz (getvar "dimzin"))
  (setvar "dimzin" 0)
 (setq ort (getvar "orthomode"))
  (setvar "orthomode" 0)
(while 
      (setq spt (getpoint "\nТочка вставки пикета (Enter для завершения): "))
  (setvar "osmode" 0)
      (setq ept (getpoint spt "\nТочка полочки текста: "))
  (if (> (car ept)(car spt))
    (setq flag t)
    (setq flag nil))
  (setq ang  (angle spt ept))
  ;;квадранты:
(setq ang  (cond
  ((> (/ pi 2.)  ang 0)(dtr 65.))
  ((> pi  ang (/ pi 2.))(dtr 115.))
  ((> (* pi 1.5)  ang pi)(dtr 245.))
  ((> (* pi 2.)  ang (* pi 1.5))(dtr 325.))
  (T (dtr 65.)))
	)

  (if flag (progn (setq mpt (polar spt ang 7.77))
	     (setq txtpt (polar mpt 0.0 1.89)))
    (progn(setq mpt (polar spt ang 7.77))
	     (setq txtpt (polar mpt pi 1.89))))
 (setq dimp  (vlax-curve-getclosestpointto pl spt)
      leg (vlax-curve-getdistatparam pl (vlax-curve-getparamatpoint pl dimp))
      dist(/ leg 100.)
       ) 
  (setq	mtx (vlax-invoke
	      acsp 'AddMText txtpt	0.0  
  
  (strcat "ПК: " (itoa (fix dist)) " + "(rtos (* (- dist (fix dist))100.) 2 prec)))
  )
  (vlax-put mtx 'StyleName "Standard");<-- text style name
  (vlax-put mtx 'Height textheight);<--text height
  (vlax-put mtx 'Layer "Пикеты") ;<--layer name
  (vlax-put mtx 'Color 256);<--color bylayer
  (if flag
  (vlax-put mtx 'AttachmentPoint 4)
  (vlax-put mtx 'AttachmentPoint 6)
    )
  (vlax-put mtx 'InsertionPoint  txtpt)


  (setq ldobj (vlax-invoke
    acsp
    'Addleader
    (apply 'append (list spt mpt txtpt))
    mtx
    acLineWithArrow
  )
	)
  (vla-put-layer ldobj (vlax-get mtx 'Layer))
  (vla-put-arrowheadsize ldobj textheight)
  (vla-put-textgap ldobj textheight)
  (vla-put-verticaltextposition ldobj acVertCentered)
  (setvar "osmode" 1)
  )
 ;;;     ;расскомметировать если надо для блоков
;;; (setq n 0)
;;;	(while (< n (vlax-curve-getendparam pl))
;;;      (setq blk (vlax-invoke  acsp 'insertblock 
;;;					  (vlax-curve-getclosestpointto pl (vlax-curve-getpointatparam pl n))
;;;		  "KL"
;;;					     1. 1. 1. 0.))
;;;
;;;	  (foreach attrib (vlax-invoke blk 'getAttributes)
;;;          (if
;;;            (eq (strcase (vla-get-tagstring attrib)) "НОМЕР")
;;;    
;;;              (vla-put-textstring attrib (itoa (+ n 1)))
;;;              
;;;            )
;;;          )
;;;      
;;;	  (setq n (1+ n))
;;;	  )
  )
 )
 (*error* nil)
	(princ)
	 )
(prompt "\n")
(prompt "\n	***	Старт команда: \"Pikets\"	*** \n")
(prin1)
(vl-load-com)
(princ)

_'J'_

Leher27 · 18.01.2012, 16:00

Запробовал, работает не совсем так как изначально хотелось, но всё равно супер. Времени сэкономится куча. Огромное спасибо тебе!!!

Олег (jr.) · 18.01.2012, 17:12

Пож-ста,
Успехов

-'J'-

Ровнов Алексей · 04.10.2015, 17:30

Олег, у меня после выбора полилинии выдаёт в командной строке <Selection set: 6bb> или <Selection set: 6c0> в зависимости в какое место полилинии тыкну при выборе. подскажи пож-та в чём может быть проблемма.... а вообще мне очень нужно, чтобы автоматически выставились выноски в вершинах нескольких полилиний со сквозной нумерацией их вершин (по часовой первая с северо-запада). Именно такого лиспа в сети не нашёл. Очень хорошая прога взята из geo_tools (в аттаче), но она не может учитывать северо-запад и строит выноски только по-одному контуру (последующий контур нумеруется после добавления к сущ. таблице) и если контур состоит из например 5-ти точек и замкнут, то первая точка нумеруется №1 и после обхода 2 3 4 5 в точку №1 ставится выноска №6. помогите пож-та мне доработать программку. с сегодняшнего дня я начал сам изучать программирование в автокаде, но думаю не скоро осилю свои задачи.

Ровнов Алексей · 04.10.2015, 17:32

файлик не прикрепился к первому сообщению

16.01.2012, 12:42		#1
Как сделать выноски пикетажа в вершины полилинии. Leher27 Регистрация: 09.01.2012 Сообщений: 49 Уважаемые корифеи!!! Задача следующая: имеется полилиния (ось трассы КЛ). Необходимо создать выноски пикетажа в вершинах этой полилинии (в поворотных точках трассы). Находил лиспик для создания пикетажа, но там необходимо каждый раз кликать по полилинии для простановки выносок. А мне нужно,что бы пикетаж проставлялся в вершины сразу по клику по полилинии. Сам программировать на лиспе пока не умею, хотя планирую освоить. Умею только пользоваться готовыми программами (прошу не хихикать, многие и этого не могут). Если есть такой лисп, буду благодарен очень.
Просмотров: 9122

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
выноски к полилинии	gizmo_zx	Программирование	6	01.03.2010 12:17
Оптимизация (уменьшение количества) точек в полилинии. Как сделать? Очень нужно..	xaoc25	AutoCAD	2	27.11.2009 15:18
Из чего сделать несущие стены для индивидуального жилого дома	Минька	Конструкции зданий и сооружений	32	24.03.2009 11:49
Помогите продумать поворот части выноски!	Tonic	Программирование	40	02.07.2007 20:21
Сброс связи линии выноски и MTEXTа выноски	kabzzz	AutoCAD	3	19.04.2006 12:57

	Реклама i