[vn]

Три года назад скачал программу 3DSPIRAL для вычерчивания пружин в объеме. Но сейчас она очень плохо работает. Сильные искажения. Может быть кто-то сумеет найти неполадку в программе.

;;; 3DSPIRAL.LSP
;;; --------------------------------------------------------------------------;
;;; ;;; This program constructs a spiral. It can be loaded and called
;;; by typing either "spiral", "3dspiral" or the following:
;;; (cspiral <# rotations> <base point> <horiz growth per rotation>
;;; <points per circle> <start radius>
;;; <vert growth per rotation>).
;;;
;;; --------------------------------------------------------------------------;

(defun myerror (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setvar "cmdecho" ocmd) ; Restore saved modes
(setvar "blipmode" oblp)
(setq *error* olderr) ; Restore old *error* handler
(princ)
)

(defun cspiral (ntimes bpoint hfac lppass strad vfac
/ ang dist tp ainc dhinc dvinc circle dv)

(setvar "blipmode" 0) ; turn blipmode off
(setvar "cmdecho" 0) ; turn cmdecho off
(setq circle (* 3.141596235 2))
(setq ainc (/ circle lppass))
(setq dhinc (/ hfac lppass))
(if vfac (setq dvinc (/ vfac lppass)))
(setq ang 0.0)
(if vfac
(setq dist strad dv 0.0)
(setq dist 0.0)
)
(if vfac
(command "3dpoly") ; start spiral ...
(command "pline" bpoint) ; start spiral from base point and...
)
(repeat ntimes
(repeat lppass
(setq tp (polar bpoint (setq ang (+ ang ainc))
(setq dist (+ dist dhinc))
)
)
(if vfac
(setq tp (list (car tp) (cadr tp) (+ dv (caddr tp)))
dv (+ dv dvinc)
)
)
(command tp) ; continue to the next point...
)
)
(command "") ; until done.
(princ)
)

;;;
;;; Interactive spiral generation
;;;

(defun C:SPIRAL (/ olderr ocmd oblp nt bp cf lp)
;;;;(setq olderr *error*
;;;; *error* myerror)
(setq ocmd (getvar "cmdecho"))
(setq oblp (getvar "blipmode"))
(setvar "cmdecho" 0)
(initget 1) ; bp must not be null
(setq bp (getpoint "\nCenter point: "))
(initget 7) ; nt must not be zero, neg, or null
(setq nt (getint "\nNumber of rotations: "))
(initget 3) ; cf must not be zero, or null
(setq cf (getdist "\nGrowth per rotation: "))
(initget 6) ; lp must not be zero or neg
(setq lp (getint "\nPoints per rotation <30>: "))
(cond ((null lp) (setq lp 30)))
(cspiral nt bp cf lp nil nil)
(setvar "cmdecho" ocmd)
(setvar "blipmode" oblp)
(setq *error* olderr) ; Restore old *error* handler
(princ)

)

;;;
;;; Interactive spiral generation
;;;

(defun C:3DSPIRAL (/ olderr ocmd oblp nt bp hg vg sr lp)
;;;;(setq olderr *error*
;;;; *error* myerror)
(setq ocmd (getvar "cmdecho"))
(setq oblp (getvar "blipmode"))
(setvar "cmdecho" 0)
(initget 1) ; bp must not be null
(setq bp (getpoint "\nCenter point: "))
(initget 7) ; nt must not be zero, neg, or null
(setq nt (getint "\nNumber of rotations: "))
(initget 7) ; sr must not be zero, neg, or null
(setq sr (getdist bp "\nStarting radius: "))
(initget 1) ; cf must not be zero, or null
(setq hg (getdist "\nHorizontal growth per rotation: "))
(initget 3) ; cf must not be zero, or null
(setq vg (getdist "\nVertical growth per rotation: "))
(initget 6) ; lp must not be zero or neg
(setq lp (getint "\nPoints per rotation <30>: "))
(cond ((null lp) (setq lp 30)))
(cspiral nt bp hg lp sr vg)
(setvar "cmdecho" ocmd)
(setvar "blipmode" oblp)
(setq *error* olderr) ; Restore old *error* handler
(princ)

)

;;; --------------------------------------------------------------------------;
(princ "\n\tC:SPIRAL and C:3DSPIRAL loaded. ")
(princ)

[Александр Ривилис]

Если без анализа кода, то отключи перед запуском команды привязки или измени строки программы:

Код:

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

(command "pline" bpoint) ; start spiral from base point and...

на:

Код:

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

(command "_pline" "_none" bpoint) ; start spiral from base point and...

и строку

Код:

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

(command tp) ; continue to the next point...

на строку

Код:

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

(command "_none" tp) ; continue to the next point...

[vn]

Александру Ривилису спасибо!
Искажений нет. Вы правы: спираль захватывали привязки на фоне которых я строил спираль. После внесения указанных Вами изменений искажения мсчезли.
Уважаемый Александр!
Если соединить линией начало и конец спирали, то видно, что число витков неполное. А я ведь задавал целое число! Можно ли изменить программу, чтобы задавать дробное значение витков? (12.5 ; и т. п.)

[Александр Ривилис]

Возможно это оно:

Код:

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

;;; 3DSPIRAL.LSP 
;;; --------------------------------------------------------------------------; 
;;; ;;; This program constructs a spiral. It can be loaded and called 
;;; by typing either "spiral", "3dspiral" or the following: 
;;; (cspiral <# rotations> <base point> <horiz growth per rotation> 
;;; <points per circle> <start radius> 
;;; <vert growth per rotation>). 
;;; 
;;; --------------------------------------------------------------------------; 

(defun myerror (s)                      ; If an error (such as CTRL-C) occurs 
                                        ; while this command is active... 
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  ) ;_ end of if
  (setvar "cmdecho" ocmd)               ; Restore saved modes 
  (setvar "blipmode" oblp)
  (setq *error* olderr)                 ; Restore old *error* handler 
  (princ)
) ;_ end of defun

(defun cspiral (ntimes
                bpoint
                hfac
                lppass
                strad
                vfac
                /
                ang
                dist
                tp
                ainc
                dhinc
                dvinc
                circle
                dv
               )

  (setvar "blipmode" 0)                 ; turn blipmode off 
  (setvar "cmdecho" 0)                  ; turn cmdecho off 
  (setq circle (* PI 2.0))
  (setq ainc (/ circle lppass))
  (setq dhinc (/ hfac lppass))
  (if vfac
    (setq dvinc (/ vfac lppass))
  ) ;_ end of if
  (setq ang 0.0)
  (if vfac
    (setq dist strad
          dv   0.0
    ) ;_ end of setq
    (setq dist 0.0)
  ) ;_ end of if
  (if vfac
    (command "_.3dpoly")                ; start spiral ... 
    (command "_.pline" "_none" bpoint)  ; start spiral from base point and... 
  ) ;_ end of if
  (repeat (fix (+ ntimes 1e-6))
    (repeat lppass
      (setq tp (polar bpoint ang dist))
      (setq ang (+ ang ainc))
      (setq dist (+ dist dhinc))
      (if vfac
        (setq tp (list (car tp) (cadr tp) (+ dv (caddr tp)))
              dv (+ dv dvinc)
        ) ;_ end of setq
      ) ;_ end of if
      (command "_none" tp)              ; continue to the next point... 
    ) ;_ end of repeat
  ) ;_ end of repeat
  (setq nlast (abs (- ntimes (fix ntimes))))
  (repeat (1+ (fix (+ 1e-6 (* lppass nlast))))
      (setq tp (polar bpoint ang dist))
      (setq ang (+ ang ainc))
      (setq dist (+ dist dhinc))
      (if vfac
        (setq tp (list (car tp) (cadr tp) (+ dv (caddr tp)))
              dv (+ dv dvinc)
        ) ;_ end of setq
      ) ;_ end of if
      (command "_none" tp)              ; continue to the next point... 
  ) ;_ end of repeat
  (command "")                          ; until done. 
  (princ)
) ;_ end of defun

;;; 
;;; Interactive spiral generation 
;;; 

(defun C:SPIRAL (/ olderr ocmd oblp nt bp cf lp)
;;;;(setq olderr *error* 
;;;; *error* myerror) 
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (initget 1)                           ; bp must not be null 
  (setq bp (getpoint "\nCenter point: "))
  (initget 7)                           ; nt must not be zero, neg, or null 
  (setq nt (getreal "\nNumber of rotations: "))
  (initget 3)                           ; cf must not be zero, or null 
  (setq cf (getdist "\nGrowth per rotation: "))
  (initget 6)                           ; lp must not be zero or neg 
  (setq lp (getint "\nPoints per rotation <30>: "))
  (cond ((null lp) (setq lp 30)))
  (cspiral nt bp cf lp nil nil)
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp)
  (setq *error* olderr)                 ; Restore old *error* handler 
  (princ)

) ;_ end of defun

;;; 
;;; Interactive spiral generation 
;;; 

(defun C:3DSPIRAL (/ olderr ocmd oblp nt bp hg vg sr lp)
;;;;(setq olderr *error* 
;;;; *error* myerror) 
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (initget 1)                           ; bp must not be null 
  (setq bp (getpoint "\nCenter point: "))
  (initget 7)                           ; nt must not be zero, neg, or null 
  (setq nt (getreal "\nNumber of rotations: "))
  (initget 7)                           ; sr must not be zero, neg, or null 
  (setq sr (getdist bp "\nStarting radius: "))
  (initget 1)                           ; cf must not be zero, or null 
  (setq hg (getdist "\nHorizontal growth per rotation: "))
  (initget 3)                           ; cf must not be zero, or null 
  (setq vg (getdist "\nVertical growth per rotation: "))
  (initget 6)                           ; lp must not be zero or neg 
  (setq lp (getint "\nPoints per rotation <30>: "))
  (cond ((null lp) (setq lp 30)))
  (cspiral nt bp hg lp sr vg)
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp)
  (setq *error* olderr)                 ; Restore old *error* handler 
  (princ)

) ;_ end of defun

;;; --------------------------------------------------------------------------; 
(princ "\n\tC:SPIRAL and C:3DSPIRAL loaded. ")
(princ)

[vn]

Еще раз спасибо Александр Ривилис!
Вот теперь программа Lux!
А то, чем она была раньше - халтура.
[ATTACH]1144220080.dwg[/ATTACH]

[shnn]

offtop
>vn
Сэр, Вы не правы!!! Вы успешно пользовались прогой в ранних версиях??? Зачем же вы оскорбляете автора?? откуда ему знать о нововведениях Autodesk в свежих версиях AutoCAD?? Кроме того болезнь адаптации старых программ к новым версиям существует давно.

[Александр Ривилис]

shnn
Добавлю от себя. Здесь проблема была не в старой и новой версии AutoCAD, а в включенных и выключенных привязках и (!!!) в не вполне корректной логике работы программы, в связи с чем количество витков получалось не целым. Хотя называть ее халтурой я бы не стал.

[shnn]

хм... в таком случае я отзываю вторую чать сообщения, но

Сэр, Вы не правы!!!

оставляю

[vn]

Извиняюсь Вовсе не хотел оскорбить автора начальной версии.
Однако много крови мне эта ранняя версия попортила из-за ее особенностей . Просто нигде не было указано, что она для обучения или демонстрационная.