• Palya
  • Восстановленный участник
  • На форуме с 7 марта 2006г.
  • Сообщений: 9
  • Спасибо: 0

Тема: как сменить направление пикетажа на обратное

сделана трасса из полилинии. Как сменить направление пикетажа?

  • ABoltrushko
  • Восстановленный участник
  • На форуме с 26 февраля 2003г.
  • Сообщений: 366
  • Спасибо: 1

Re: как сменить направление пикетажа на обратное

> Palya
Не мое, но использую:
;; REVPOLY.LSP
;; Reverts order of vertices of a selected (not closed) polyline.
;; Supports bulge, different widthes of the polyline segments,
;; FITted and SPLINEd polylines
;; 15.04.97  S.Komarov
(defun C:REVPOLY (/ pl pln cass i ent vlist blist swl ewl)
(defun CASS (cod ent)
  (cdr(assoc cod (entget ent)))
)
(setq pl (entsel "Select polyline:"))
(if pl
(progn
(setq pl (car pl))
(if (and (equal "POLYLINE" (cass 0 pl))
          (/= 1 (cass 70 pl)))
(progn
(setq pln pl i 0)
(while (not (= "SEQEND" (cass 0 (setq pln (entnext pln)))))
        (setq blist (cons (cass 42 pln) blist)
              vlist (cons (entget pln) vlist)
              swl (cons (cass 40 pln) swl)
              ewl (cons (cass 41 pln) ewl)
              i  (1+ i)
        )
)
(setq blist (append (cdr blist)(list (car blist)))
       blist (mapcar '(lambda (x) (- 0 x)) blist)
         swl (append (cdr swl)(list (last swl)))
         ewl (append (cdr ewl)(list (last swl)))
           i 0 pln pl
)
(setq ent (cdr (entget pln))
       ent (subst (cons 40 (car ewl))(assoc 40 ent) ent)
       ent (subst (cons 41 (last swl))(assoc 41 ent) ent)
)
(entmake ent) ; polyline
(while (not (= "SEQEND" (cass 0 (setq pln (entnext pln)))))
     (progn
     (setq ent (nth i vlist)
           ent (subst (cons 40 (nth i ewl))(assoc 40 ent) ent)
           ent (subst (cons 41 (nth i swl))(assoc 41 ent) ent)
           ent (subst (cons 42 (nth i blist))(assoc 42 ent) ent)
           i (1+ i)
     )
     (entmake ent)
))
(entmake (cdr (entget pln))); seqend
(entdel pl)(redraw(entlast))
(princ "\nDone!")
)
(prompt "\nNot a polyline or closed polyline")
)
)
(prompt "\nNothing selected!")
)
(princ)
)
(prompt "\nProgram loaded. Call by REVPOLY")(princ)

  • Palya
  • Восстановленный участник
  • На форуме с 7 марта 2006г.
  • Сообщений: 9
  • Спасибо: 0

Re: как сменить направление пикетажа на обратное

> ABoltrushko
Спасибо.
Тоже не моё, (вот только что нашел). Вроде работает нормально:
(defun c:rlw(/ E LW X1 X2 X3 X4 X5 X6)
(if(and(setq lw(car(entsel "\nSelect lwpolyline")))
(=(cdr(assoc 0(setq e(entget lw)))) "LWPOLYLINE"))
(progn
(foreach a1 e
(cond
((=(car a1) 10)(setq x2(cons a1 x2)))
((=(car a1) 40)(setq x4(cons(cons 41(cdr a1)) x4)))
((=(car a1) 41)(setq x3(cons(cons 40(cdr a1)) x3)))
((=(car a1) 42)(setq x5(cons(cons 42(-(cdr a1))) x5)))
((=(car a1) 210)(setq x6(cons a1 x6)))
(t(setq x1(cons a1 x1)))))
(entmod
(append
(reverse x1)
(append
(apply
(function append)
(apply
(function mapcar)
(cons
'list
(list x2
(cdr(reverse(cons(car x3)(reverse x3))))
(cdr(reverse(cons(car x4)(reverse x4))))
(cdr(reverse(cons(car x5)(reverse x5))))))))x6)))
(entupd lw))))И до кучи проверка направления обхода вершин, в отличии от многих
            программ выдает правильный результат во всех сложных случаях,
            впрочем если нет пересечений...
(defun c:lwcl(/ LW LST MAXP MINP)
(setq lw(vlax-ename->vla-object(car(entsel))))
(vla-GetBoundingBox lw 'MinP 'MaxP)
(setq
minp(vlax-safearray->list minp)
MaxP(vlax-safearray->list MaxP)
lst(mapcar(function(lambda(x)
(vlax-curve-getParamAtPoint lw
(vlax-curve-getClosestPointTo lw x))))
(list minp(list(car minp)(cadr MaxP))
MaxP(list(car MaxP)(cadr minp)))))
(if(or
(<=(car lst)(cadr lst)(caddr lst)(cadddr lst))
(<=(cadr lst)(caddr lst)(cadddr lst)(car lst))
(<=(caddr lst)(cadddr lst)(car lst)(cadr lst))
(<=(cadddr lst)(car lst)(cadr lst)(caddr lst)))t))PS. Сложными случаями я назвал полилинию с кучей вершин, в середине,
            но снаружи имеющие всего один дуговой сегмент, типа разомкнутого
            кольца, имеющего по внутренней окружности много сегментов, а на
            внешнем только один, и очень маленькую ширину...

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: как сменить направление пикетажа на обратное

> Palya
Кстати, это мое...