ElpanovEvgeniy | Ширина сегмента полилинии

Ширина сегмента полилинии

(defun C:lw_width (/ ENDWIDTH GR LW PAR STARTWIDTH)
                     ;|
*****************************************************************************************

by ElpanovEvgeniy


 Изменение начальной и конечной ширины произвольного сегмента полилинии.


Дата создания       - 08.02.2008
*****************************************************************************************

 Change of initial and final width of any segment of a polyline.

Date of creation  - 08.02.2008
*****************************************************************************************

 USAGE:
 (C:lw_width)

*****************************************************************************************
|;
 (vl-load-com)
 (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
 (vla-endundomark adoc)
 (vla-startundomark adoc)
 (setq lw (entsel "\n Выберите нужный сегмент в полилинии. "))
 (if (and lw (= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE"))
  (progn
   (setq par (vlax-curve-getparamatpoint
              (vlax-ename->vla-object (car lw))
              (vlax-curve-getclosestpointto (vlax-ename->vla-object (car lw))
                                            (trans (cadr lw) 1 0)
              ) ;_  vlax-curve-getclosestpointto
             ) ;_  vlax-curve-getparamatpoint
         lw  (vlax-ename->vla-object (car lw))
   ) ;_  setq
   (princ "\n Задайте ширину начала сегмента: ")
   (vla-getwidth lw (fix par) 'StartWidth 'EndWidth)
   (while (and (setq gr (grread 5)) (= (car gr) 5))
    (vla-setwidth
     lw
     (fix par)
     (setq
      StartWidth (* (distance (trans (cadr gr) 1 0)
                              (vlax-curve-getclosestpointto lw (trans (cadr gr) 1 0))
                    ) ;_  distance
                    2.
                 ) ;_  *
     ) ;_  setq
     EndWidth
    ) ;_  vla-setwidth
   ) ;_  while
   (if (= (car gr) 2)
    (vla-setwidth
     lw
     (fix par)
     (setq StartWidth (atof (strcat (princ (vl-list->string (cdr gr))) (getstring))))
     EndWidth
    ) ;_  vla-setwidth
   ) ;_  if
   (princ "\n Задайте ширину конца сегмента: ")
   (while (and (setq gr (grread 5)) (= (car gr) 5))
    (vla-setwidth lw
                  (fix par)
                  StartWidth
                  (* (distance (trans (cadr gr) 1 0)
                               (vlax-curve-getclosestpointto lw (trans (cadr gr) 1 0))
                     ) ;_  distance
                     2.
                  ) ;_  *
    ) ;_  vla-setwidth
   ) ;_  while
   (if (= (car gr) 2)
    (vla-setwidth lw
                  (fix par)
                  StartWidth
                  (atof (strcat (princ (vl-list->string (cdr gr))) (getstring)))
    ) ;_  vla-setwidth
   ) ;_  if
  ) ;_  progn
  (if (= (cdr (assoc 0 (entget (car lw)))) "POLYLINE")
   (alert "Обрабатываются только легкие (LW) полилинии")
   (princ "\n Ничего не выбрано или объект не полилиния.\t")
  ) ;_  if
 ) ;_  if
 (vla-endundomark adoc)
 (princ)
) ;_  defun
Наверх
Великому и могучему языку посвящается...

Ширина сегмента полилинии
