Пикетаж с индексом

Подскажите пожалуйста, может кто знает как разбить трассу на пикеты с индексом. У меня идет одна трасса основная, а от нее идут дополнительные. И вот на них необходимо, чтобы были пикеты с индексом, например 1.

 

http://geodesist.ru/forum/resources/dr-pk-road.12/

 

Этот лисп знаю, спасибо. Но нужно что бы разбивал так ПК0₂ и ПК0₂¹ . Так как бывает много веток пересекающихся с друг другом в пределах одного проекта и необходимо их различать. А в ручную добавлять очень долго получается))

 

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

Раскрыть Спойлер Свернуть Спойлер

имхо, не надо усложнять, если речь не идет о какой-то подгонке под что-то

это VLX. Можете попробовать попросить Alexandr-GR, заменить в программе вывод пикета не в ТЕКСТ а в МТЕКСТ., тогда индекс можно будет вставить символом ^перед/нижний; ^после/верхний.

 

спасибо, попробую.

 

Вечер добрый, уважаемые форумчани. Очень хотелось бы чтоб реализовали в dr-pk-road возможность указания пикетажа в произвольной точки на трассе. Было бы очень здорово. Спасибо.

 

Dsts

Код (раскрыть) Код (свернуть)

(defun C:DSTS (/ adoc *error* crvs eps dL pts pt1 pt2 ptc n osm vx p1 p2)
;;; Расстояние от начала полилинии до опеделенной точки
;;; Запрос выбора полилинии
;;; http://forum.dwg.ru/showthread.php?t=8713
;;; Отмерить по линии расстояние и поставить точку
;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=49398
(defun *error* (msg)(if mut (setvar 'NOMUTT mut))(princ msg)
(vl-cmdf "_redrawall")(vla-EndUndoMark adoc)(setvar "OSMODE" osm))
(defun dr_st (pt ang color / pt1 pt2)
(setq pt1 (polar pt (+ ang 2.35619) (* 0.03 (getvar "VIEWSIZE"))))
(setq pt2 (polar pt (+ ang 3.92699) (* 0.03 (getvar "VIEWSIZE"))))
(grvecs (list color pt1 pt pt pt2)))
(defun dr_kr (pt color / pt11 pt12 pt21 pt22 len)
(setq len (* 0.02 (getvar "VIEWSIZE"))
pt11 (polar pt 3.92699 len)
pt12 (polar pt 0.785398 len)
pt21 (polar pt 5.49779 len)
pt22 (polar pt 2.35619 len))
(grvecs (list color pt11 pt12 pt21 pt22)))
(defun getblg ( pl / blglist i n ent_data tmp_ent)
(setq ent_data (entget pl))
(cond ((= (cdr(assoc 0 ent_data)) "LWPOLYLINE")
(setq blglist (mapcar 'cdr (vl-remove-if-not(function(lambda(x)(= 42(car x)))) ent_data))))
(t (setq tmp_ent pl)
(while (/= "SEQEND" (cdr(assoc 0 (entget(setq tmp_ent (entnext tmp_ent))))))
(setq blglist (append blglist (list (cdr(assoc 42 (entget tmp_ent)))))))))
blglist)
(vl-load-com)(setq osm (getvar "OSMODE"))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-StartUndoMark adoc)
(setvar "CMDECHO" 0)
(and
(progn
(setq mut (getvar 'NOMUTT))
(setvar 'NOMUTT 1)
(princ "\nВыберите кривую: ")
(setq ss (ssget "_:E:S" (list (cons 0 "*LINE,ARC")(cons 410 (getvar 'CTAB)))))
(setvar 'NOMUTT mut) ss
)
(if (setq pt (getpoint "\nУкажите точку на кривой <выход> : "))
(progn
(setq en (ssname ss 0)
crv (vlax-ename->vla-object en)
pt (vlax-curve-getclosestpointto crv (trans pt 1 0))
ds (vlax-curve-getDistAtParam crv (vlax-curve-getEndParam crv)))
(cond ((= (vla-get-ObjectName crv) "AcDbLine")
(setq ds1 (distance (cdr(assoc 10 (entget en))) pt)))
((or (= (vla-get-ObjectName crv) "AcDb3dPolyline")
(and
(= (vla-get-ObjectName crv) "AcDb2dPolyline")
(/= (logand (cdr(assoc 70 (entget en))) 2) 2) ;_Fit
(/= (logand (cdr(assoc 70 (entget en))) 4) 4) ;_Spline
(vl-every 'zerop (getblg en))
)
(and
(= (vla-get-ObjectName crv) "AcDbPolyline")
(vl-every 'zerop (getblg en))
)
)
(setq vx ((lambda ( / i lst)(while (<= (setq i (if i (1+ i) 0))(vlax-curve-getEndParam crv))
(setq lst (append lst (list (vlax-curve-getPointAtParam crv i))))) lst)))
(setq p1 (car vx) vx (cdr vx) ds1 0)
(while (and (setq p2 (car vx))
(not (equal (+ (distance Pt P1) (distance Pt P2)) (distance P1 P2) 0.00001))
)
(setq vx (cdr vx) ds1 (+ ds1 (distance P1 P2)) p1 p2)
)
(setq ds1 (+ ds1 (distance P1 Pt))))
(t (setq ds1 (vlax-curve-getDistAtParam
crv (vlax-curve-getParamAtPoint crv pt)))))
(dr_st (trans pt 0 1)
(angle (trans pt 0 1)
(trans (vlax-curve-getPointAtParam crv
(+ (vlax-curve-getParamAtDist crv ds1) 0.0001))
0 1)) 1)
(dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 1)
(initget "Поменять Change _C C")
(princ "\nДлинна объекта ")(princ ds1)
(princ " [Поменять начало] <готово>:")(setq en (getkword))
(if (= en "C")
(progn (dr_kr (trans (vlax-curve-getStartPoint crv) 0 1) 0)
(dr_kr (trans (vlax-curve-getEndPoint crv) 0 1) 1)
(setq ds1 (- ds ds1))
)
)
(princ "\nВторая точка выноски :")
(if (getvar "CMLEADERSTYLE")
(draw-mleader
pt ;_ начальная точка
pause ;_запрос второй точкм
(list
(strcat "ПК" (rtos (atoi (rtos (/ ds1 100) 2 2)) 2 0) "+" (vl-string-subst "," "." (rtos (rem ds1 100) 2 2))) ;_1-я строка, длина до 2 знаков после запятой
)
1.5 ;_Вытота текста
0.87 ;_Значение коэффициента см
;;; тему http://forum.dwg.ru/showpost.php?p=656758&postcount=51
0.2 ;_отступ 1-го параграфа (форматтирование \\pxa)
)
(vl-cmdf "_LEADER"
(trans pt 0 1)
pause
""
(rtos ds1 2 3)
"" )
)
)
)
)
(setvar "OSMODE" osm)
(vla-EndUndoMark adoc)
(vl-cmdf "_redrawall")
(princ))
(defun draw-mleader (pt1 pt2 strlist Htxt koeff abz / dic mlst i)
;;; pt1 - начальная точка UCS
;;; pt2 - конечная точка UCS
;;; strlist - список строк
;;; Htxt - высота текста
;;; koeff - коэфф форматирования pxe или nil
;;; abz - коэфф форматирования абзаца \\pa или Nil
;;;(draw-mleader (setq pt1(getpoint))(getpoint pt1)(list "Пример" "Минскинжпроект" "Третья строка") 1.5 0.9 nil)
;;; Стиль мультивыноски текущий
(setq i 0)
(command
"_mleader"
"_h"
"_none"
pt1
"_none"
pt2
(strcat (if koeff (strcat "\\px"
(if abz (strcat "a"(VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR abz))",") "")
"se" (VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR koeff))";") "") ;;;"\\pxse0.87;"
;;; "\\pa0.15;" (car strlist) "\\pa0;"
(car strlist)
)
)
(while (> (getvar "CMDACTIVE") 0) (command ""))
(setq dic (vlax-ename->vla-object (entlast)))
(vla-put-TextString dic
(strcat (if koeff (strcat "\\px"
(if abz (strcat "a"(VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR abz))",") "")
"se" (VL-STRING-RIGHT-TRIM "0" (MIP-CONV-TO-STR koeff))";") "") ;;;"\\pxse0.87;"
;;; "\\pa0.15;" (car strlist) "\\pa0;"
(car strlist)
;;; (if abz "\\pa0;" "")
(apply 'strcat
(mapcar '(lambda (x) (strcat "\\P" (if (= (setq i (1+ i)) 1)(if abz "\\pa0;" "") "") x)) (cdr strlist))
) ;_ end of apply
) ;_ end of strcat
)
(vla-put-TextHeight dic Htxt)
dic
)
(defun mip-conv-to-str (dat)
(cond ((= (type dat) 'INT) (setq dat (itoa dat)))
((= (type dat) 'REAL) (setq dat (rtos dat 2 12)))
((null dat) (setq dat ""))
(t (setq dat (vl-princ-to-string dat)))
) ;_ end of cond
) ;_ end of defun
(princ "\nНаберите в командной строке DSTS")

чет форум не дает вложения вставить