Доработка программы изменения направления линии

Diman-2

Diman-2
Активный участник

Откуда: Краснодарский край / Краснодар
На форуме с 20 июня 2006г.
Сообщений: 152
Спасибо: 0

Тема: Доработка программы изменения направления линии

одскажите пожалуйста, как доработать программу по изменению направления полилинии, что бы можно было селектировать сразу несколько полилиний и менять у них направление на "по часовой стрелке", при этом подсчитывая, ск-ко было с обратным?

(defun GetVertexList (entlist / vertlist coords)
(setq vertlist (member (assoc 10 entlist) entlist))
(repeat (cdr (assoc 90 entlist))
(setq coords (cons (cdar vertlist) coords)
vertlist (cddddr vertlist)))
(reverse coords)
) ;end defun
(defun GEO_CCW (p0 p1 p2 / dx1 dx2 dy1 dy2)
(setq dx1 (- (car p1) (car p0))
dy1 (- (cadr p1) (cadr p0))
dx2 (- (car p2) (car p0))
dy2 (- (cadr p2) (cadr p0)))
(cond
((> (* dx1 dy2) (* dy1 dx2)) 1)
((< (* dx1 dy2) (* dy1 dx2)) -1)
(t
(cond
((or (minusp (* dx1 dx2))
(minusp (* dy1 dy2))) -1)
;; explicit distance
((>= (+ (* dx1 dx1) (* dy1 dy1)) (+ (* dx2 dx2) (* dy2 dy2))) 0)
(t 1)
)
)
)
) ;end defun
(defun c:PlineCCW (/ pline res ptlst rptlst lay)
(setq pline (entsel "\nSelect lwpolyline"))
(setq ptlst (GetVertexList (entget (car pline))))
(setq res (GEO_CCW (nth 0 ptlst) (nth 1 ptlst) (nth 2 ptlst)))
(if (= res -1)
(princ "\nНаправление против часовой."))
(if (= res 1)
(progn
(setvar "cmdecho" 0)
(setq lay (getvar "clayer"))
(setq rptlst (reverse ptlst))
(setvar "clayer" (cdr (assoc 8 (entget (car pline)))))
(command "_pline" (foreach p rptlst (command p)))
(command "_erase" (car pline) "")
(setvar "clayer" lay)
(setvar "cmdecho" 1)
(princ "\Направление по часовой стрелке.")
) ;end progn
) ;end if
(princ)
) ;end defun

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Доработка программы изменения направления линии

;;;Реверс LW полилиний
;;;Код Евгения Елпанова
;;;https://www.caduser.ru/forum/topic20537.html
(defun plineLW-reverse ( lw / e x1 x2 x3 x4 x5 x6)
  (if (= (type lw) 'VLA-OBJECT)
    (setq lw (vlax-vla-object->ename lw)))
    (setq e (entget lw))
(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)))
     ) ;_ end of cond
   )
(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))))
         ) ;_ end of list
        ) ;_ end of cons
      ) ;_ end of apply
         ) ;_ end of apply
       x6
       ) ;_ end of append
     ) ;_ end of append
   ) ;_ end of entmod
  (entupd lw)
  ) ;_ end of defun
;проверка направления обхода вершин
;https://www.caduser.ru/forum/topic20537.html
;Евгений Елпанов
;Возвращаем t   - по часовой
;           nil - против
(defun lwcl( lw  / LST MAXP MINP)
(if (= (type lw) 'ENAME)
    (setq lw (vlax-ename->vla-object lw)))
(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 nil))
(defun C:PlineCCW ( / int:i e1 list:pt res clk+)
  (vl-load-com)
  (or *activedoc*
       (setq *activedoc* (vla-get-activedocument (vlax-get-acad-object))))
  (vla-startundomark *activedoc*)
  (princ "\nВыберите Полилинии")
  (setq PICK1 nil
    PICK1 (ssget "_:L" '((0 . "LWPOLYLINE"))))
  (setq int:i 0 clk+ 0)
  (while (and PICK1 (setq e1 (ssname PICK1 int:i)))
    (setq list:pt (pline-get-verts e1))
    (if (> (length list:pt) 2)
    (if (lwcl e1)
      (progn
        (plineLW-reverse e1)
        (setq clk+ (1+ clk+))
        )
      ))
    (setq int:i (1+ int:i))
  )
  (princ (strcat "\nОбработано " (itoa int:i) " полилиний. Из них"))
  (princ "\n\t")(princ clk+)(princ " \tпо часовой (реверсировано)")
  (princ "\n\t")(princ (- int:i clk+))(princ " \tпротив часовой")
  (setq PICK1 nil)(vla-endundomark *activedoc*) (princ))

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Доработка программы изменения направления линии

Прошу прощения. Выше полилинии меняют направление на "против часовой"
По часовой здесь

;;;Реверс LW полилиний
;;;Код Евгения Елпанова
;;;http://www.arcada.com.ua/forum/viewtopic.php?t=481&sid=69bf50f6022d526c7c56ad2029d9f24c
(defun plineLW-reverse ( lw / e x1 x2 x3 x4 x5 x6)
  (if (= (type lw) 'VLA-OBJECT)
    (setq lw (vlax-vla-object->ename lw)))
    (setq e (entget lw))
(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)))
     ) ;_ end of cond
   )
(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))))
         ) ;_ end of list
        ) ;_ end of cons
      ) ;_ end of apply
         ) ;_ end of apply
       x6
       ) ;_ end of append
     ) ;_ end of append
   ) ;_ end of entmod
  (entupd lw)
  ) ;_ end of defun
;проверка направления обхода вершин
;https://www.caduser.ru/forum/topic20537.html
;Евгений Елпанов проверка
;Возвращаем t   - по часовой
;           nil - против
(defun lwcl( lw  / LST MAXP MINP)
(if (= (type lw) 'ENAME)
    (setq lw (vlax-ename->vla-object lw)))
(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 nil))
(defun C:PlineCCW ( / int:i e1 list:pt res clk+)
  (vl-load-com)
  (or *activedoc*
       (setq *activedoc* (vla-get-activedocument (vlax-get-acad-object))))
  (vla-startundomark *activedoc*)
  (princ "\nВыберите Полилинии")
  (setq PICK1 nil
    PICK1 (ssget "_:L" '((0 . "LWPOLYLINE"))))
  (setq int:i 0 clk+ 0)
  (while (and PICK1 (setq e1 (ssname PICK1 int:i)))
    (setq list:pt (pline-get-verts e1))
    (if (> (length list:pt) 2)
    (if (not(lwcl e1))
      (progn
        (plineLW-reverse e1)
        (setq clk+ (1+ clk+))
        )
      ))
    (setq int:i (1+ int:i))
  )
  (princ (strcat "\nОбработано " (itoa int:i) " полилиний. Из них"))
  (princ "\n\t")(princ clk+)(princ " \tпротив часовой (реверсировано)")
  (princ "\n\t")(princ (- int:i clk+))(princ " \tпо часовой")
  (setq PICK1 nil)(vla-endundomark *activedoc*) (princ))

Diman-2

Diman-2
Активный участник

Откуда: Краснодарский край / Краснодар
На форуме с 20 июня 2006г.
Сообщений: 152
Спасибо: 0

Re: Доработка программы изменения направления линии

no function definition: PLINE-GET-VERTSno function definition: PLINE-GET-VERTS пишет

Diman-2

Diman-2
Активный участник

Откуда: Краснодарский край / Краснодар
На форуме с 20 июня 2006г.
Сообщений: 152
Спасибо: 0

Re: Доработка программы изменения направления линии

После вставки
; ошибка: неверный тип аргумента: VLA-OBJECT <Имя объекта: 7ef82e98>

Diman-2

Diman-2
Активный участник

Откуда: Краснодарский край / Краснодар
На форуме с 20 июня 2006г.
Сообщений: 152
Спасибо: 0

Re: Доработка программы изменения направления линии

Вставки pline-get-verts

Diman-2

Diman-2
Активный участник

Откуда: Краснодарский край / Краснодар
На форуме с 20 июня 2006г.
Сообщений: 152
Спасибо: 0

Re: Доработка программы изменения направления линии

> VVA
кстати спасибо за помощь в выгрузке текста в
Excel, все работает идеально

VVA

VVA
Активный участник

Откуда: Беларусь / Минск
На форуме с 29 марта 2006г.
Сообщений: 1,859
Спасибо: 25

Re: Доработка программы изменения направления линии

> Диман-2
Сорри

;;;Реверс LW полилиний
;;;Код Евгения Елпанова
;;;http://www.arcada.com.ua/forum/viewtopic.php?t=481&sid=69bf50f6022d526c7c56ad2029d9f24c
(defun plineLW-reverse ( lw / e x1 x2 x3 x4 x5 x6)
  (if (= (type lw) 'VLA-OBJECT)
    (setq lw (vlax-vla-object->ename lw)))
    (setq e (entget lw))
(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)))
     ) ;_ end of cond
   )
(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))))
         ) ;_ end of list
        ) ;_ end of cons
      ) ;_ end of apply
         ) ;_ end of apply
       x6
       ) ;_ end of append
     ) ;_ end of append
   ) ;_ end of entmod
  (entupd lw)
  ) ;_ end of defun
;проверка направления обхода вершин
;https://www.caduser.ru/forum/topic20537.html
;Евгений Елпанов проверка
;Возвращаем t   — по часовой
;           nil — против
(defun lwcl( lw  / LST MAXP MINP)
(if (= (type lw) 'ENAME)
    (setq lw (vlax-ename->vla-object lw)))
(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 nil))
(defun C:PlineCCW ( / int:i e1 res clk+)
  (vl-load-com)
  (or *activedoc*
       (setq *activedoc* (vla-get-activedocument (vlax-get-acad-object))))
  (vla-startundomark *activedoc*)
  (princ "\nВыберите Полилинии")
  (setq PICK1 nil
  PICK1 (ssget "_:L" '((0 . "LWPOLYLINE"))))
  (setq int:i 0 clk+ 0)
  (while (and PICK1 (setq e1 (ssname PICK1 int:i)))
    (if (not(lwcl e1))
      (progn
        (plineLW-reverse e1)
        (setq clk+ (1+ clk+))
        )
      )
    (setq int:i (1+ int:i))
  )
  (princ (strcat "\nОбработано " (itoa int:i) " полилиний. Из них"))
  (princ "\n\t")(princ clk+)(princ " \tпротив часовой (реверсировано)")
  (princ "\n\t")(princ (- int:i clk+))(princ " \tпо часовой")
  (setq PICK1 nil)(vla-endundomark *activedoc*) (princ))
(princ "\nType PlineCCW to start command")

Diman-2

Diman-2
Активный участник

Откуда: Краснодарский край / Краснодар
На форуме с 20 июня 2006г.
Сообщений: 152
Спасибо: 0

Re: Доработка программы изменения направления линии

КЛАСС!!!
Спасибо!

Доработка программы изменения направления линии

Сообщения 9

#1 Тема от Diman-2 21 марта 2007г. 15:10:54

Тема: Доработка программы изменения направления линии

#2 Ответ от VVA 21 марта 2007г. 16:55:10

Re: Доработка программы изменения направления линии

#3 Ответ от VVA 21 марта 2007г. 16:58:10

Re: Доработка программы изменения направления линии

#4 Ответ от Diman-2 21 марта 2007г. 17:28:06

Re: Доработка программы изменения направления линии

#5 Ответ от Diman-2 21 марта 2007г. 18:05:25

Re: Доработка программы изменения направления линии

#6 Ответ от Diman-2 21 марта 2007г. 18:05:54

Re: Доработка программы изменения направления линии

#7 Ответ от Diman-2 21 марта 2007г. 18:23:06

Re: Доработка программы изменения направления линии

#8 Ответ от VVA 21 марта 2007г. 18:30:43

Re: Доработка программы изменения направления линии

#9 Ответ от Diman-2 21 марта 2007г. 18:48:50

Re: Доработка программы изменения направления линии

Сообщения 9

Тему читают: 1 гость

Вход на форум «Форумы CADUser»x

Ссылки