[khanter72rus]

Нужно отложить на своей ломаной кривой (прям на ней) линию нужной мне длины из любой точки на этой кривой таким образом чтобы новая линия лежала непосредственно на старой, т.е. повторяла ее изгибы. Заранее спасибо.

[Кулик Алексей aka kpblc]

Сообщение от khanter72rus Хочу

Откладывай, кто мешает-то?

[khanter72rus]

Крыс помоги. Я исправился.

[Хмурый]

скопировать линию на линию.
разорвать копию линии в нужной точке
применить команду _lengthen _t и задать длину.

[VVA]

Пробуй. С дуговыми сегментами не проверял, но судя по

(сегменты состоят из отрезков)

оно и не нужно

Код:

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

(defun C:TEST ()
    (vl-load-com)

(setq pline (vlax-ename->vla-object (car(entsel))))
(setq par1
       (vlax-curve-getParamAtPoint pline
       (vlax-curve-getClosestPointTo pline (setq pt1(getpoint "\n1-я ТОчка на кривой: ")))
         )
      )
(setq par2
       (vlax-curve-getParamAtPoint pline
       (vlax-curve-getClosestPointTo pline (getpoint pt1 "\n2-я точка на кривой (направление): "))
         )
      )
(setq dist (getdist "\nДлина: "))
(if (> par2 par1)
  (setq par2
  (vlax-curve-getParamAtDist pline
  (+
  (vlax-curve-getDistAtParam pline par1)
  dist
  )
    )
        )
  (setq par2
  (vlax-curve-getParamAtDist pline
  (-
  (vlax-curve-getDistAtParam pline par1)
  dist
  )
    )
        )
  )
;;;  (vla-Highlight
;;;    (CopySegments pline (setq params (list par1 par2)))
;;;    :vlax-true
;;;  )
    (sssetfirst nil
      (ssadd
        (vlax-vla-object->ename
          (CopySegments pline (setq params (list par1 par2)))
          )
        )
      )

  )

(defun CopySegments (pline params / nor space tmp copy)
;; Arguments
;; pline : the source polyline (vla-object)
;; params ; the index list of segment to be copied
;;
;; Return
;; created polylines

  (vl-load-com)
  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (setq	params (vl-sort params '<)
	nor    (vlax-get pline 'Normal)
	space  (vla-ObjectIDToObject *acdoc* (vla-get-OwnerID pline))
  )
    (setq tmp (list(setq i(car params))))
    (while (< (setq i (fix(1+ i)))(cadr params))
      (setq tmp (cons i tmp))
      )
    (setq tmp (reverse(cons (cadr params) tmp)))
    (setq
      pts
       (vl-remove nil
		  (mapcar
		    (function
		      (lambda (pa / pt)
			(if (setq pt (vlax-curve-getPointAtParam pline pa))
			  ((lambda (p)
			     (list (car p) (cadr p))
			   )
			    (trans pt 0 nor)
			  )
			)
		      )
		    )
		    tmp
		  )
       )
    )
    (setq copy
	   (vlax-invoke
	     space
	     'addLightWeightPolyline
	     (apply 'append pts)
	   )
    )
  (foreach p tmp
      (vla-setBulge
	copy
	(vl-position p tmp)
	(vla-getBulge pline p)
      )
      (vla-getWidth pline p 'swid 'ewid)
      (vla-setWidth copy (vl-position p tmp) swid ewid)
    )
  
    (foreach prop '(Elevation	    Layer	    Linetype
		    LinetypeGeneration		    LinetypeScale
		    Lineweight	    Normal	    Thickness
		    TrueColor
		   )
      (if (vlax-property-available-p pline prop)
	(vlax-put copy prop (vlax-get pline prop))
      )
    )
    copy
)

Без всяких проверок (габариты полилинии, блокировка слоев и т.п.)

[khanter72rus]

(setq pt1(getpoint "\n1-ÿ Òî÷êà íà ïîëèëèíèè: "))) Я не понимаю чего ему нужно =) Набираю _TEST просит выделить объект, а потом вот это.

[VVA]

khanter72rus, Обновил #5
Заодно нашел у себя еще пару ссылок
http://forum.dwg.ru/showthread.php?p=281928#post281928
http://forum.dwg.ru/showthread.php?p=817520#post817520