[kitep]

Господа, как перекатать AlxdDike.arx, для нанесения б/штрихов для autocad 2008

[DEM]

Сообщение от kitep Господа, как перекатать AlxdDike.arx, для нанесения б/штрихов для autocad 2008

Странно но под КАД 2006 у меня она тоже не пошла
Есть програмка Откос(автор Скляров Игорь), но она отрисовывет все линиями на слое 0, нельзя ли её поправить и сделать отрисовку на текущем слое, а так же отрисовку не линиями, а блоками (возможно хоть это уменьшит вес черт).
Если бы она не была скомпилирована то Я бы и сам возможно справился, но увы она скомпилирована.

[kitep]

DEM спасибо, "обчертилась"

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

В качестве первого приближения (полностью решение есть в ruCAD'e):

Код:

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

(defun c:berg (/
             *error*
             adoc
             up
             low
             diff
             dist
             up_len
             low_len
             up_dist
             low_dist
             space
             loc:highlight
             scaling
             line
             )

  (defun loc:highlight (ent high)
    (vl-catch-all-apply '(lambda () (vla-highlight ent high)))
    t
    ) ;_ end of defun

  (defun *error* (msg)
    (mapcar '(lambda (x) (loc:highlight x :vlax-false)) (list up low))
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (if (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    '(lambda ()
                       (prompt "\nУкажите верхнюю бровку")
                       (setq up (ssget "_:S" '((0 . "*LINE"))))
                       ) ;_ end of lambda
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           up
           (> (sslength up) 0)
           (setq up (vlax-ename->vla-object (ssname up 0)))
           (loc:highlight up :vlax-true)
           (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    '(lambda ()
                       (prompt "\nУкажите верхнюю бровку")
                       (setq low (ssget "_:S" '((0 . "*LINE"))))
                       ) ;_ end of lambda
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           low
           (> (sslength low) 0)
           (setq low (vlax-ename->vla-object (ssname low 0)))
           (loc:highlight low :vlax-true)
           (not (equal low up))
           (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    '(lambda ()
                       (setq dist
                              (getdist
                                "\nРасстояние между соседними штрихами верхней кромки <Отмена> : "
                                ) ;_ end of getdist
                             ) ;_ end of setq
                       ) ;_ end of lambda
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           dist
           ) ;_ end of and
    (progn
      (setq diff     (/ (* (setq low_len (vlax-curve-getdistatpoint
                                           low
                                           (vlax-curve-getendpoint low)
                                           ) ; _ end of
          ; vlax-curve-getDistAtPoint
                                 ) ;_ end of setq
                           dist
                           ) ;_ end of *
                        (setq up_len (vlax-curve-getdistatpoint
                                       up
                                       (vlax-curve-getendpoint up)
                                       ) ;_ end of vlax-curve-getDistAtPoint
                              ) ;_ end of setq
                        ) ;_ end of /
            space    (vla-objectidtoobject adoc (vla-get-ownerid up))
            up_dist  (- dist)
            low_dist (- diff)
            scaling  t
            ) ;_ end of setq
      (while
        (and
          (<= ;|(vlax-curve-getpointatdist up |;
            (setq up_dist (+ up_dist dist)) ;)
            up_len
            ) ;_ end of <=
          (<= ;| (vlax-curve-getpointatdist low |;
            (setq low_dist (+ low_dist diff)) ;)
            low_len
            ) ;_ end of <=
          ) ;_ end of and
         (setq line (vla-addline
                      space
                      (vlax-3d-point
                        (vlax-curve-getpointatdist up up_dist)
                        ) ;_ end of vlax-3d-point
                      (vlax-3d-point
                        (vlax-curve-getpointatdist low low_dist)
                        ) ;_ end of vlax-3d-point
                      ) ;_ end of vla-addline
               ) ;_ end of setq
         (if (setq scaling (not scaling))
           (vla-scaleentity line (vla-get-startpoint line) 0.5)
           ) ;_ end of if
          ; debug:
         (vla-regen adoc acactiveviewport)
         ) ;_ end of while
      ) ;_ end of progn
    ) ;_ end of if
  (mapcar '(lambda (x) (loc:highlight x :vlax-false)) (list up low))
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Примитивы должны быть нарисованы "в одном направлении", тестировал только для варианта 2Д. Рисуется отрезками на текущем слое с текущими установками.

[To Thuc]

Добрый вечер. Подскажите, пожалуйста, как програмировать для случая перпендикуляных откосов. Программа s_otkos Склярова не работает во многих случаях. Причина мне не явна.

[Alxd]

Чего т я не уловил? Берг-штрих и alxddike чем связаны?

P.S. AlxdDike под 2007, равно как и под 2008 уже давно существует. Качайте http://www.alx.ncn.ru/download/alxddike2007.zip

[Valery Brelovsky]

Сообщение от Alxd Чего т я не уловил? Берг-штрих и alxddike чем связаны? P.S. AlxdDike под 2007, равно как и под 2008 уже давно существует. Качайте http://www.alx.ncn.ru/download/alxddike2007.zip

Я в программировании не понимаю потому и вопрос такой.
Можно ли переименовать файл AlxdDike в AlxdDike2008. Работаю в 2006 и там то же файл с именем AlxdDike. Что бы не путаться. Или последний годится и для 2006.

[To Thuc]

Большое спасибо вам Alxd. Но мне еще интересно алгоритм . Если у вас есть возможность, приложите сюда, пожалуйста, коды или указание. (Я только чайник в программировании.)

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

Valery Brelovsky, arx-приложения, написанные под 2006, не будут работать под 2007 и выше. Верно и обратное. Из собственного опыта: сам arx я переименовывал, к фатальным последствиям это (пока?) не приводило. Как вариант без переименования: просто сделай отдельные папки под arx 2004-2006 и 2007-2008, это будет наиболее безболезненно ИМХО.

[Valery Brelovsky]

Сообщение от Кулик Алексей aka kpblc Valery Brelovsky, arx-приложения, написанные под 2006, не будут работать под 2007 и выше. Верно и обратное. Из собственного опыта: сам arx я переименовывал, к фатальным последствиям это (пока?) не приводило. Как вариант без переименования: просто сделай отдельные папки под arx 2004-2006 и 2007-2008, это будет наиболее безболезненно ИМХО.

Спасибо за ответ. Они у меня в разных папках. И в настройках указал пути к разным папкам, думаю Автокад разберется.
Просто смущало одинаковое имя файлов. А в жизни всякое бывает.

[Valery Brelovsky]

Сообщение от To Thuc Большое спасибо вам Alxd. Но мне еще интересно алгоритм . Если у вас есть возможность, приложите сюда, пожалуйста, коды или указание. (Я только чайник в программировании.)

Я гружу и работаю с этим приложением вот таким макросом для кнопки.
^C^C(if (not C:_dike) (arxload "AlxdDike.arx")) _dike

[Alxd]

Алгоритм??? Хех... высшая математика, раздел "Производные"

[To Thuc]

У меня проблема с производной не существует
Хоршо, сам попробую.