Деление отрезка на НЕравные части

Рамка · 30.09.2005, 01:11

Есть отрезок, нужно расставить точки на разных расстояниях друг от друга (координаты их не известны, известны только расстояния от одного из концов отрезка). Есть ли такая команда в автокаде (у меня 2005)? если нет, то как это проще сделать? точек много очень

Vova · 30.09.2005, 03:58

Вообще-то, программу надо писать. Но пока программисты спят, попробуй чисто автокадовскую примочку-калькулятор. Придется сделать 2 кнопки, см. ниже. Работать надо так:
1. Взять нужную команду, например, Copy. Захватить объект, который расставляется по линии
2. Нажать на кнопку с таким макросом: '_Cal;pld(end.end,
3. К тому, что появится в ком. строке, добавить нужное расстояние и вместо нажатия на Enter
3. нажать на кнопку с таким простым макросом: ); То есть скобка и точка с запятой, больше ничего.
4. Хлопнуть по концам линии
Все
Если автокад 2005 или 06, продолжай работу с этой линией, так как цопирование здесь множественное.Если в принципе устраивает, можно поработать над уменьшением количества щелчков, но надо-бы задачу поподробнее поставить

Лентяй · 30.09.2005, 05:20

Если задан список дистанций от начала отрезка ptl, то все довольно просто.

Код:

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

(defun DevUn (ptl / spt ept ang)
  (setq om (getvar "OSMODE")
        ent (car (entsel)) obj (vlax-ename->vla-object line)
        spt ((vlax-curve-getStartPoint obj) ept (vlax-curve-getEndPoint obj)
        lng (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)));setq
  (setq bpl (mapcar '(lambda (x) (vlax-curve-getPointAtDist obj x)) ptl))
  (foreach bp bpl
    (command "_break" ent bp bp)
    (setq ent (entlast)));foreach
  (setvar "OSMODE" om)
);end

Работает для прямых и дуг. Для полилиний не проверял. Тоже, наверное, работает :? .

Torino · 30.09.2005, 08:26

Без лиспа и макросов:
строим несколько окружностей с центром в начале линии и радиусами равными данным длинам.
В точках пересечения окружностей и линии находятся искомые точки.

wjea · 30.09.2005, 08:37

А почему нельзя просто офсетом?

{Smirnoff} · 30.09.2005, 09:04

Пока не без мелких недостатков, однако размечает любые линии (в т. ч. сплайны, окружности и эллипсы) на участки неравной длинны. Данные можно скопировать из колонки Excel, можно водить вручную.

Код:

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

(defun c:делин(/ ACTDOC ACTLAY ACTSP CURPT CURVELAY CURVELEN
         DDIST ABSDIS DPNT ENDLN FILEN FIRSTSUMDIS
         INSLN LAYSTATE notClosed MIDPT MSGTEX NEWSPH
         NEXTDIS NEXTPT OBJLST OLDABSDIS OLDBLOCK
         OLDDELTADIS OLDDIST OLDDIVD OLDMODE OLDNEXTDIS
         OLDOSMODE OLDPT OLDSPH PTNDIRECT READIST
         REVFLAG SCURVE SELBL SELFLAG STLEN STPT
         DELTADIS UDIST UPNT *ERROR*)

  (vl-load-com)

  (defun Error_And_Quit(/)
    (if sCurve
      (vla-Highlight sCurve :vlax-false)
      ); end if
    (if stPt
      (vla-Delete stPt)
      ); end if
    (if newSph
      (vla-Delete newSph)
      ); end if
    (if layState
      (foreach lay layState
  (vla-put-Lock(car lay)(cadr lay))
  ); end foreach
      ); end if
    (if oldOsmode
      (setvar "OSMODE" oldOsmode)
      ); end if
    (if(and curveLen objLst AbsDis)
      (progn
  (if(= odiv:Divd "Точка-точка")
      (setq stLen(apply '+(mapcar '(lambda(x)(nth 4 x))objLst))
      fiLen(- stLen(nth 4(last objLst)))
      ); end setq
    ); end if
      (princ
        (strcat
    "\n++++++++++++++++++++ Репортаж ++++++++++++++++++++\n\n"
    "Текущий режим разметки: "
     (if(= odiv:Divd "Точка-точка") "Точка-Точка" "Старт-точка")"\n"
    "Длинна объекта: " (rtos curveLen) "\n"
                "Точек размечено: "(itoa(length objLst)) "\n"
    (if(= odiv:Divd "Точка-точка")
      (progn
        (princ
          (strcat
    "Длинна от стартовой до последней точки: "(rtos stLen) "\n"
    "Длинна от первой до последней точки: "(rtos fiLen) "\n"
           ); end strcat
          ); end princ
        ); end progn
      ""
       ); end if
    "\n+++++++++++++++++ Конец репортажа ++++++++++++++++\n"
     ); end strcat
    ); end princ
        ); end progn
      (princ "\n*** Выход из ДЕЛИН ***")
      ); end if
    (vla-EndUndoMark actDoc)
    (princ)
    ); end of Error_And_Quit


  (defun *error* (msg)
    (Error_And_Quit)
    (princ)
    ); end of *error*


  (setq actDoc(vla-get-ActiveDocument
    (vlax-get-acad-object))); end setq
  (vla-StartUndoMark actDoc)
  (if(not odiv:Mode)(setq odiv:Mode "Точки"))
  (if(not odiv:Block)(setq odiv:Block "не определен"))
  (if(not odiv:Divd)(setq odiv:Divd "Точка-точка"))
  (initget "Точки Блоки")
  (setq oldMode odiv:Mode
  odiv:Mode
   (getkword
     (strcat "\nВыберите тип разметки [Точки/Блоки] <"odiv:Mode">: "))
  ); end setq
  (setq oldOsmode(getvar "OSMODE"))
  (if(= 1(vla-get-ActiveSpace actDoc))
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end if
  (if(null odiv:Mode)(setq odiv:Mode oldMode))
  (if(= "Блоки" odiv:Mode)
    (progn
      (while(not selFlag)
      (setq oldBlock odiv:Block
      odiv:Block
       (getstring
         (strcat "\nНазвание блока или [Выбрать на экране] <"odiv:Block">: "))
      ); end setq
      (if(= "" odiv:Block)(setq odiv:Block oldBlock))
      (if(or(= "В" odiv:Block)(= "в" odiv:Block))
  (progn
    (setq odiv:Block nil)
    (while(not selBl)
      (setq selBl(entsel "\nВыберите блок "))
      (if
        (and selBl
       (/=(cdr(assoc 0(entget(car selBl)))) "INSERT")
       ); end and
    (setq selBl nil)
          (setq odiv:Block(cdr(assoc 2(entget(car selBl)))))
    ); end if
      ); end while
    ); end progn
  ); end if
  (if(tblsearch "BLOCK" odiv:Block)
    (setq selFlag T)
    (princ(strcat "\nБлок с названием: " odiv:Block " не найден! "))
    ); end if
   ); end while
  ); end progn
      ); end if
  (initget "Точка-точка Старт-точка")
  (setq oldDivd odiv:Divd
  odiv:Divd
   (getkword
     (strcat
       "\nВыберите режим разметки [Точка-точка/Старт-точка] <"odiv:Divd">: ")))
  (if(null odiv:Divd)(setq odiv:Divd oldDivd))
  (while(not uPnt)
    (setvar "OSMODE" 571)
    (setq uPnt
     (getpoint
       (strcat "\nВыберите точку на отрезке или кривой ")))
    (if(and uPnt
      (setq sCurve(ssget uPnt '((-4 . "<OR")(0 . "LINE")(0 . "LWPOLYLINE")
             (0 . "3DPOLYLINE")(0 . "POLYLINE")
             (0 . "SPLINE")(0 . "ARC")(0 . "ELLIPSE")
             (0 . "CIRCLE")(-4 . "OR>")))
      ); end setq
      ); end and
      (progn
  (setq sCurve(vlax-ename->vla-object(ssname sCurve 0))
        curveLen(vlax-curve-getDistAtParam sCurve
          (vlax-curve-getEndParam sCurve))
        actLay(vla-get-ActiveLayer actDoc)
        curveLay(vla-Item
      (vla-get-Layers actDoc)
      (vla-get-Layer sCurve))
        layState(list
      (list actLay(vla-get-Lock actLay))
      (list curveLay(vla-get-Lock actLay))
      ); end list
        ); end setq
  (vla-put-Lock actLay :vlax-false)
  (vla-put-Lock curveLay :vlax-false)
  (vla-Highlight sCurve :vlax-true)

  (if(vlax-curve-isClosed sCurve)
    (progn
      (princ "\n*** Замкнутый контур ***")
      (setq notClosed nil)
      ); end progn
    (progn
      (if
       (> 0.1(distance
         (vlax-curve-getStartPoint sCurve)
         (vlax-curve-getEndPoint sCurve)
         ); end distance
       )
       (princ "\n*** ВНИМАНИЕ! Возможно \"зрительно замкнутый\" (незамкнутый) контур ***")
       ); end if
            (setq notClosed T)
       ); end progn
    ); end if
  (setq stPt(vla-AddSphere actSp
        (vlax-3d-point uPnt)
            (/(getvar "VIEWSIZE")120))
        ); end setq
  (vla-put-Color stPt 1)
       (if notClosed
   (progn
  (cond
    ((equal uPnt(vlax-curve-getStartPoint sCurve))
     (setq revFlag 0)
     ); end condition #1
    ((equal uPnt(vlax-curve-getEndPoint sCurve))
     (setq revFlag 1)
     ); end condition #2
    (t
     (setq revFlag 2)
     ); end condition #3
    ); end cond
  ); end progn
   (setq revFlag 2)
   ); end if
  ); end progn
    (setq uPnt nil)
      ); end if
  ); end while
  (if(= revFlag 2)
    (progn
          (while(not dPnt)
       (if
   (setq dPnt
    (getpoint
      (strcat "\nУкажите точку в направлении разметки ")))
   (progn
   (if
     (not
       (setq dDist(vlax-curve-getDistAtPoint sCurve dPnt)))
     (progn
     (princ "\nТочка не пренадлежит линии!")
     (setq dPnt nil)
     ); end progn
     ); end if
   ); end progn
   (princ "\nТочка не выбрана!")
   ); end if
       );end while
     ); end progn
    ); end if
(setq uDist(vlax-curve-getDistAtPoint sCurve uPnt))

  (if(and uDist dDist)
    (progn
      (if(>= uDist (/ curveLen 2))
  (progn
    (setq midPt(vlax-curve-getPointAtDist sCurve
           (- uDist
       (/ curveLen 2)))
    ); end setq
    (if(and
         (>= dDist(vlax-curve-getDistAtPoint sCurve midPt))
         (<= dDist uDist)
     ); end and
      (setq ptnDirect T)
      ); end if
    ); end progn
  (progn
    (setq midPt(vlax-curve-getPointAtDist sCurve
           (+ uDist
       (/ curveLen 2))))
    (if(or
         (and
     (>= dDist 0.0)
     (<= dDist uDist)
     ); end and
         (and
     (>= dDist(vlax-curve-getDistAtPoint sCurve midPt))
     (<= dDist curveLen)
     ); and
         ); or
      (setq ptnDirect T)
      ); end if
    ); end progn
  ); end if
      ); end progn
    ); end if
  (setq objLst '()
  nextDis "0.0"
  AbsDis 0.0
  ); end setq
  (cond
    ((= revFlag 2)
       (setq DeltaDis uDist)
      ); end condition #1
    ((= revFlag 0)
     (setq DeltaDis 0.0)
     ); end condition #2
    ((= revFlag 1)
     (setq DeltaDis curveLen)
     ); end condition #3
     ); end cond
  (setq firstSumDis DeltaDis)
  (while(not(member nextDis '("в" "В")))
    (setq oldAbsDis AbsDis
    oldDeltaDis DeltaDis
          oldDist nextDis
    repCount 1
          nextDis
     (getstring
       (strcat"\nВведите расстояние или [Отменить/Выйти] <"nextDis"> : "))
    ); end setq
    (if(= "" nextDis)(setq nextDis oldDist))
    (if
      (vl-string-search "," nextDis)
      (setq nextDis(vl-string-subst "." "," nextDis))
      ); end if
    (cond
      ((and
   (setq reaDist(distof nextDis))
   (not(member nextDis '("в" "В" "о" "О")))
   ); end and
       (progn
   (if(minusp reaDist)
     (setq reaDist(- reaDist))
     ); end if
   (setq oldDist DeltaDis)
   (cond
     ((not notClosed)
      (if(= odiv:Divd "Точка-точка")
        (progn
      (if(not ptnDirect)
        (progn
    (if(>= curveLen(+ DeltaDis reaDist))
          (setq DeltaDis(+ DeltaDis reaDist))
    (setq DeltaDis(-(+ DeltaDis reaDist)curveLen))
      ); end if
    ); end progn
        ); end if
     (if ptnDirect
        (progn
    (if(<= 0.0 (- DeltaDis reaDist))
          (setq DeltaDis(- DeltaDis reaDist))
    (setq DeltaDis(+(- DeltaDis reaDist)curveLen))
      ); end if
    ); end progn
        ); end if
      (setq AbsDis(+ AbsDis reaDist))
      ); end progn
        (progn
      (if(not ptnDirect)
        (progn
    (if(>= curveLen(+ uDist reaDist))
          (setq DeltaDis (+ uDist reaDist))
    (setq DeltaDis(-(+ uDist reaDist)curveLen))
      ); end if
    ); end progn
        ); end if
     (if ptnDirect
        (progn
    (if(<= 0.0 (- uDist reaDist))
          (setq DeltaDis(- uDist reaDist))
    (setq DeltaDis(+(- uDist reaDist)curveLen))
      ); end if
    ); end progn
        ); end if
      (setq AbsDis reaDist)
      ); end progn
        ); end if
      ); end condition #1
     ((= revFlag 0)
      (if(= odiv:Divd "Точка-точка")
        (progn
      (setq DeltaDis(+ DeltaDis reaDist)
      AbsDis(+ AbsDis reaDist)
      ); end setq
        ); end progn
        (progn
      (setq DeltaDis reaDist
      AbsDis reaDist
      ); end setq
    ); end progn
        ); end if
      ); end condition #2
     ((= revFlag 1)
       (if(= odiv:Divd "Точка-точка")
         (progn
      (if(= reaDist 0.0)
        (setq reaDist 0.00001)
        ); end if
      (setq DeltaDis(- DeltaDis reaDist)
      AbsDis(+ AbsDis reaDist)
      ); end setq
      ); end progn
         (progn
      (setq DeltaDis(- curveLen reaDist)
      AbsDis reaDist
      ); end setq
     ); end progn
         ); end if
      ); end condition #3
     ((and notClosed(= revFlag 2))
      (if(<= uDist dDist)
      (progn
     (if(= odiv:Divd "Точка-точка")
       (progn
     (setq DeltaDis(+ DeltaDis reaDist)
     AbsDis(+ AbsDis reaDist)
     ); end setq
        ); end progn
       (progn
     (setq DeltaDis (+ reaDist uDist)
     AbsDis reaDist); end setq
      ); end progn
       ); end if
        ); end progn
      (progn
    (if(= odiv:Divd "Точка-точка")
      (progn
     (setq DeltaDis(- DeltaDis reaDist)
     AbsDis(+ AbsDis reaDist)
     ); end setq
        ); end progn
      (progn
     (setq DeltaDis (- uDist reaDist)
     AbsDis reaDist); end setq
      ); end progn
               ); end if
        ); end progn
        ); end if
      ); end conditon #4
     ); end cond
       (if
    (or
      (and(not notClosed)(>= curveLen AbsDis))
      (and(/= revFlag 2)(>= curveLen AbsDis))
      (and
        notClosed(= revFlag 2)(<= uDist dDist)
        (>= curveLen(+ uDist AbsDis))
        ); end and
      (and
        notClosed(= revFlag 2)(> uDist dDist)
        (<= AbsDis uDist)
        ); end and
      ); end or
       (progn
         (if nextPt(setq oldPt nextPt))
           (setq nextPt
        (vlax-curve-getPointAtDist sCurve DeltaDis)
          ); end setq
         (if
     (and
       oldPt
       (= odiv:Divd "Старт-точка")
       (equal oldPt nextPt)
       ); end and
     (alert
       (strcat
            "ТОЧКА ИЛИ БЛОК С ДУБЛИРУЮЩИМИСЯ КООРДИНАТАМИ                 \n\n"
      "Вы работаете в режиме Старт-Точка и расстояния откладываются\n"
      "от выбранного вами конца отрезка или кривой. Точка на таком\n"
      "расстоянии от конца линии уже существует. Вы можете удалить ее\n"
      "командой Отменить."
         ); end strcat
      ); end alert
     ); end if
         (if(= odiv:Mode "Точки")
     (progn
          (setq curPt(vla-AddPoint actSp
           (vlax-3d-point nextPt)))
    (if(member(getvar "PDMODE") '(0 1))
      (progn
        (if newSph
          (progn
          (setq oldSph newSph)
          (vla-Delete oldSph)
          ); end progn
         ); end if
         (setq newSph(vla-AddSphere actSp
           (vlax-3d-point nextPt)
                         (/(getvar "VIEWSIZE")120))
          ); end setq
        (vla-put-Color newSph 3)
         ); end progn
        ); end if
       ); end progn
     (setq curPt
      (vla-InsertBlock actSp (vlax-3d-point nextPt)
        odiv:Block 1.0 1.0 1.0 0))
          ); end if
          (setq objLst(append
                   (list(list curPt DeltaDis AbsDis nextPt reaDist))objLst)
         ); end setq
         (if(= odiv:Divd "Точка-точка")
         (princ(strcat "\nСуммарная длинна разметки = " (rtos AbsDis)))
     ); end if
         ); end progn
       (progn
       (cond
         ((or(and(not notClosed)(= odiv:Divd "Точка-точка"))(/= revFlag 2))
    (setq insLn(- AbsDis curveLen)
          endLn(- curveLen(- AbsDis reaDist))
          ); end setq
    ); end condition #1
         ((and(not notClosed)(= odiv:Divd "Старт-точка"))
    (setq endLn curveLen
          insLn (- AbsDis curveLen)
          ); end setq
    ); end condition #2
((and notClosed(= revFlag 2))
     (if(<= uDist dDist)
       (progn
       (setq insLn(-(+ AbsDis uDist)curveLen)
       endLn(- reaDist insLn)
       ); end setq
       ); end progn
       (progn
       (setq insLn(- AbsDis uDist)
       endLn(- reaDist insLn)
       ); end setq
       ); end progn
       ); end if
    ); end condition #3
         ); end cond
       (setq AbsDis oldAbsDis
       DeltaDis oldDeltaDis); end setq
       (alert
         (strcat "НЕДОСТАТОЧНО ДЛИННЫ ДЛЯ РАЗМЕТКИ          \n\n"
           "Текущий режим разметки: "
           (if(= odiv:Divd "Точка-точка") "Точка-Точка" "Старт-точка")"\n"
           "Требуемая длинна участка: " (rtos reaDist) "\n"
           "Длинна неразмеченной части: " (rtos endLn) "\n"
           "Нехватает для разметки: " (rtos insLn) "\n"
           "Длинна объекта: " (rtos curveLen) "\n"
           "Точек размечено: "(itoa(length objLst)) "\n"
           ); end strcat
         ); end alert
    ); end progn
   ); end if
   (setq oldNextDis nextDis)
        ); end progn
       ); end condition #1
      ((member nextDis '("о" "О"))
       (progn
        (if objLst
   (progn
     (vla-Delete(caar objLst))
     (if(> 1(length objLst))
       (progn
       (setq AbsDis(nth 2(cadr objLst))
       DeltaDis(cadar objLst)
       ); end setq
       ); end progn
       (progn
       (setq AbsDis 0.0
       DeltaDis firstSumDis
       ); end setq
       ); end progn
       ); end if
     (if newSph
       (progn
         (vla-Delete newSph)
         (setq newSph nil)
         (if(/= 1(length objLst))
     (progn
       (setq newSph(vla-AddSphere actSp
    (vlax-3d-point(nth 3(cadr objLst)))
      (/(getvar "VIEWSIZE")120))
          ); end setq
       (vla-put-Color newSph 3)
            ); end progn
     ); end if
       ); end progn
       ); end if
     (setq objLst(cdr objLst))
    ); end progn
    (princ "\nНечего отменять!")
    ); end if
     ); end progn
       ); end condition #2
      ((member nextDis '("в" "В"))
       (Error_And_Quit)
       ); end condition #3
      (t
       (progn
   (if(< 15(strlen nextDis))
     (setq msgTex
      (strcat(substr nextDis 1 15)"..."))
     (setq msgTex nextDis)
     ); end if
   (alert
     (strcat "ВВЕДЕНЫ ОШИБОЧНЫЕ ДАННЫЕ: " msgTex "                \n\n"
       "ВНИМАНИЕ!\n\n"
       "Если вы используете массив данных скопированный через\n"
       "буфер обмена из  MS Excel или другой программы, выйдите\n"
       "из программы и исправьте ошибку.\n\n"
       "Если ввод данных осуществляется вручную, можете продолжить\n"
       "работу программы.")
     ); end alert
   ); end progn
       ); end condition #6
      ); end cond
    ); end while
  (princ)
  ); end of defun

(princ "\n*** ДЕЛИН для запуска ***")

Fogel · 30.09.2005, 09:18

Vova, извиняюсь, а зачем? Построили точку в начале отрезка, выделили и копируем (ежелив версия старая нажали m) - базовая точка та где наша точка стоит, направление - к другому концу отрезка привязкой. Остается забивать расстояния, не трогая мышь, подтверждай цифири энтером. Нафига макросы?

wjea · 30.09.2005, 09:39

{Smirnoff}
Поясните пожалуйста---делаешь набор расстояний подряд в одной строке, назначаешь вид точки, ентер и идёт разметка. Можно ли, вместо типового вида акадовской точки,назначить блок? Или блоки надо расставлять после разметки?

{Smirnoff} · 30.09.2005, 10:49

>wjea

Цитата:

Можно ли, вместо типового вида акадовской точки,назначить блок? Или блоки надо расставлять после разметки?

Можно.

Код:

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

Command: делин

Выберите тип разметки [Точки/Блоки] <Точки>: б

Название блока или [Выбрать на экране] <My_Block>: в

Выберите блок
Выберите режим разметки [Точка-точка/Старт-точка] <Точка-точка>:
Выберите точку на отрезке или кривой
Введите расстояние или [Отменить/Выйти] <0.0> : 5.24

Суммарная длинна разметки = 5.2400
Введите расстояние или [Отменить/Выйти] <5.24> : 6.756

Суммарная длинна разметки = 11.9960
Введите расстояние или [Отменить/Выйти] <6.756> : 12.00

Суммарная длинна разметки = 23.9960
Введите расстояние или [Отменить/Выйти] <12.00> : 13.56

Суммарная длинна разметки = 37.5560
Введите расстояние или [Отменить/Выйти] <13.56> : 23.899

Суммарная длинна разметки = 61.4550
Введите расстояние или [Отменить/Выйти] <23.899> : 34.2

Суммарная длинна разметки = 95.6550
Введите расстояние или [Отменить/Выйти] <34.2> : 12

Суммарная длинна разметки = 107.6550
Введите расстояние или [Отменить/Выйти] <12> : 6.2

Суммарная длинна разметки = 113.8550
Введите расстояние или [Отменить/Выйти] <6.2> : 11.1

Суммарная длинна разметки = 124.9550
Введите расстояние или [Отменить/Выйти] <11.1> : в
Длинна от стартовой до последней точки: 124.9550
Длинна от первой до последней точки: 119.7150

++++++++++++++++++++ Репортаж ++++++++++++++++++++

Текущий режим разметки: Точка-Точка
Длинна объекта: 127.6979
Точек размечено: 9
Длинна от стартовой до последней точки: 124.9550
Длинна от первой до последней точки: 119.7150

+++++++++++++++++ Конец репортажа ++++++++++++++++

[ATTACH]1128062945.GIF[/ATTACH]

Есть небольшая проблема с выбором точки и линии если через точку проходит несколько линий и просили сделать опцию чтобы блоки вращались в зависимости от наклона линии. Также хотел еще добавить внесение атрибутов с номером точки и расстоянием от предыдущей точки если конечно такие таги определены в блоке.

wjea · 30.09.2005, 10:56

{Smirnoff}
Большое спасибо, даже я понял!

Apelsinov · 30.09.2005, 11:11

Цитата:

Сообщение от {Smirnoff}

Пока не без мелких недостатков, однако размечает любые линии (в т. ч. сплайны, окружности и эллипсы) на участки неравной длинны. Данные можно скопировать из колонки Excel, можно водить вручную.

Ммм-да, за тобой не угонисся, как был фантомом так и остался

Но все равно опубликую и свой опус.
Делает ТОЛЬКО то что описано в первом посте.

Код:

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

(defun APEL-POINT-IN_LINE_DIST (/ dist dist0 start_point object S_point)
  (setq dist0 0)
  (if (and (setq start_point (entsel "\nВыбери линию:"))
	   (setq object (vlax-ename->vla-object (car start_point)))
	   (eq (vla-get-ObjectName object) "AcDbLine")
      )
    (progn
      (setq start_point
	     (cadr start_point)
      )
      (while (setq dist (getdist "\n Расстояние:"))
	(setq dist (+ dist0 dist))
	(if (< dist (vla-get-Length object))
	  (progn
	    (if
	      (< (DISTANCE start_point
			   (APEL-POINT-VARIANT_TO_LIST
			     (vla-get-EndPoint object)
			   )
		 )
		 (DISTANCE start_point
			   (APEL-POINT-VARIANT_TO_LIST
			     (vla-get-StartPoint object)
			   )
		 )
	      )
	       (setq S_point 1)
	       (setq S_point 0)
	    )
	    (APEL-POINT-PO_LINE
	      object
	      S_point
	      dist
	    )
	    (setq dist0 dist)
	  )
	)
      )
    )
    (princ "\n Не указана линия для разбивки или это не линия!")
  )
)
;;;(APEL-POINT-IN_LINE_DIST)



(defun APEL-POINT-PO_LINE (object S_point dist /)
  (if (eq 1 S_point)
    (setq dist (- (vla-get-Length object) dist))
  )
  (setq line_point (vlax-curve-getPointAtDist object dist))
  (if (eq (vla-get-ActiveSpace (APEL-ACTIVE_DOCUMENT)) 1)
    (vla-AddPoint
      (vla-get-ModelSpace (APEL-ACTIVE_DOCUMENT))
      (vlax-3d-point line_point)
    )
    (vla-AddPoint
      (vla-get-PaperSpace (APEL-ACTIVE_DOCUMENT))
      (vlax-3d-point line_point)
    )
  )
)

;;;Apelsinov
;;;18.05.05
(defun APEL-ACTIVE_DOCUMENT ()
  (if (null *apel_active_document*)
    (setq *apel_active_document*
	   (vla-get-activedocument
	     (APEL-ACAD_APPLICATION)
	   )
    )
    *apel_active_document*
  )
)

;;;Преобразование точки заданной вариантом в список координат
;;;аргумент - вариант
;;;apelsinov
;;;29.09.05
(defun APEL-POINT-VARIANT_TO_LIST (var /)
  (vlax-safearray->list (vlax-variant-value var))
)
;;;(APEL-POINT-VARIANT_TO_LIST (vla-get-StartPoint (APEL-ENTSEL "")))
;;;--> (60143.7 25552.1 0.0)

PS/ че-то я ступил, программа не совсем как просили, тут, по очереди задаются расстояния между точками, начиная с одного из концов отрезка, а не между концом и каждой из точек. Ну и ладно. Мне, например, такая пригодится

то

Рамка · 30.09.2005, 11:48

Спасибо всем, все понял. У вас суперфорум, за одну ночь столько ответов! не ожидал! буду еще обращаться

Dym · 30.09.2005, 13:19

smirnoff>

ja v vostorge, gotov zabitj o muljticopy, vmesto sueti mishoj mozhno prosto davitj na enter. etoj shtuchkoj kakto mozhno razmechatj na luche?

{Smirnoff} · 30.09.2005, 16:29

>mitjaj

Нет Ray и XLine я не предусматривал потому что можно провести достаточно длинный отрезок. А так в принципе можно добавить, но сначала, то о чём я говорил раньше.

Не надо забывать также о _divide и _measure.

Vova · 01.10.2005, 06:21

Цитата:

Сообщение от Fogel

Vova, извиняюсь, а зачем? ... Нафига макросы?

Ты совершенно прав! Для прямых не требуется ни макрос, ни лисп. Команда Copy и UCS по объекту, этого достаточно. Я зациклился на калькуляторе от горя, что он сбоит в 2006, о чем в слезах автокада говорилось

ApmeM · 02.10.2005, 01:49

И не лень писать такой скрипт. Мне кажется, что проще параллельно прямому отрезку построить более мелкие отрезки, длины которых равны расстоянию между нужными точками, а потом через привязку к конечным точкам всё перенести наисходный отрезок (_copy)

Tech · Регистрация: 18.10.2004

Цитата:

Сообщение от Рамка

Есть отрезок, нужно расставить точки на разных расстояниях друг от друга (координаты их не известны, известны только расстояния от одного из концов отрезка). Есть ли такая команда в автокаде (у меня 2005)? если нет, то как это проще сделать? точек много очень

В 2005-м и в 2006-м есть такая команда в контекстном меню - CopySelection позволяющая многократное копирование одного объекта. Нужно поставить одну точку в начале, указать направление к концу и командой CopySelection расставить точки в заданном направлении с любым шагом, водя данные в CommandLine или динамически в 2006-м. Хуже, если это кривая или сплайн, тогда , конечно понадобится LISP.
Вот простой пример подобного деления в 2005-м КАДе
[ATTACH]1128277952.dwg[/ATTACH]

koskos · 20.03.2017, 10:20

Добрый день!

Есть вопрос, можно ли для лиспа в посте #6 сделать:
1. возможность выбора нескольких полилиний или отрезков
2. расстановки на них блоков\точек, с заданием отступа от начала и конца полилинии 300 мм (или значение по выбору)
3. разделением на заданное кол-во сегментов, в данном случае получилось 4.

Такое реально вообще сделать?

Картинка

art_rrc · 20.03.2017, 17:12

Цитата:

Сообщение от koskos

Такое реально вообще сделать?

Возможно, вам есть резон более детально изучить штатный функционал, например, такие элементы как динамические массивы и динамические блоки. Это может оказаться куда производительнее, чем расстановка примитивов лиспом

Profan · 20.03.2017, 17:58

А может и не может оказаться.

30.09.2005, 01:11		#1
Деление отрезка на НЕравные части Рамка программист Фишбург Регистрация: 30.09.2005 Сообщений: 2 Есть отрезок, нужно расставить точки на разных расстояниях друг от друга (координаты их не известны, известны только расстояния от одного из концов отрезка). Есть ли такая команда в автокаде (у меня 2005)? если нет, то как это проще сделать? точек много очень
Просмотров: 8357

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск

	Реклама i