Đến nội dung


Hình ảnh
- - - - -

small gift for all autolisp programmers


  • Please log in to reply
1 reply to this topic

#1 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 01 September 2007 - 03:22 PM

;;;========================================================
;;;THIS PROGRAM SEARCHS AND REPORTS ALL FUNCTIONS
;;;_AND THEIR ARGUMENTS FROM A LISP FILE TO A TEXT FILE
;;;DO NOT USE FOR THIS FILE BECAUSE THAT WILL CAUSE ERROR!
;;;IF YOU WANT COMMENTS REWRITED IN REPORT,
;;;_YOU MUST BEGIN COMMENTS WITH MINIMUM 6 SEMICOLON (;;;;;;)
;;;THIS IS SMALL GIFT FOR ALL AUTOLISP PROGRAMMERS,
;;;_WHO ARE MY FRIENDS!
;;;APPLOAD, THEN TYPE "REF" TO RUN
;;;Written by Ssg, 01/09/2007 - CadViet Utility Team - www.cadviet.com
;;;========================================================

;;;----------------------------------------------------------------
(defun SepStr(S1 S / i L L1 S0 S2)
;;;Separate S to 3 segments, search by S1, from 1st position. Return list
(setq
i (vl-string-search S1 S)
L (strlen S)
L1 (strlen S1)
S0 (substr S 1 i)
S2 (substr S (+ i L1 1) (- L L1 i))
)
(list S0 S1 S2)
)
;;;----------------------------------------------------------------
(defun RemStr(S1 S / i);;;remove ALL S1 in S
(while (setq i (vl-string-search S1 S))
(setq S (strcat (car (SepStr S1 S)) (caddr (SepStr S1 S))))
)
S
)
;;;----------------------------------------------------------------
(defun LeftStr(S1 S) (car (SepStr S1 S)));;;Select Left of S1
;;;----------------------------------------------------------------
(defun RightStr(S1 S) (caddr (SepStr S1 S)));;;Select Right of S1
;;;----------------------------------------------------------------
(defun write_report(fs fr / f1 f2 S Fn Ag Full)
(setq f1 (open fs "r") f2 (open fr "w"))
(write-line (strcat ";;;;;;SUMMARY FUNCTIONS OF FILE: " Fs "\n") f2)
(while (setq S (read-line f1))
(setq S (vl-string-trim " \t" (strcase S T)))
(if (vl-string-search ";;;;;;" S) (write-line (strcase S) f2))
(if (and (vl-string-search "defun" S) (/= (substr S 1 1) ";"))
(progn
(setq
S (rightstr "defun" S)
Fn (vl-string-trim " \t" (leftstr "(" S))
Ag (leftstr ")" (rightstr "(" S))
)
(if (vl-string-search "/" Ag) (setq Ag (leftstr "/" Ag)))
(setq Ag (vl-string-trim " \t" Ag))
(if (/= Ag "") (setq Full (strcat "(" Fn " " Ag ")")) (setq Full (strcat "(" Fn ")")))
(write-line Full f2)
)
)
);;;end while
(close f1)
(close f2)
(alert "Finish Report!")
)
;;;===================================
(defun C:REF( / fs fr)
(setq
fs (getfiled "Select Lisp File" "" "lsp" 4)
fr (getfiled "Save Report File As" "" "txt" 1)
)
(if (and fs fr) (write_report fs fr))
(princ)
)
;;;===================================

  • 0

#2 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 04 September 2007 - 07:14 AM

I'm sorry! Program isn't correct in several cases. Please repair as below.
If you have another better way, please post up for everybody refer.
Thank you!
Ssg

;;;========================================================
;;;THIS PROGRAM SEARCHS AND REPORTS ALL FUNCTIONS
;;;_AND THEIR ARGUMENTS FROM A LISP FILE TO A TEXT FILE
;;;DO NOT USE FOR THIS FILE BECAUSE THAT WILL CAUSE ERROR!
;;;IF YOU WANT COMMENTS REWRITED IN REPORT,
;;;_YOU MUST BEGIN COMMENTS WITH MINIMUM 6 SEMICOLON (;;;;;;)
;;;THIS IS SMALL GIFT FOR ALL AUTOLISP PROGRAMMERS,
;;;_WHO ARE MY FRIENDS!
;;;APPLOAD, THEN TYPE "REF" TO RUN
;;;Written by Ssg, 04/09/2007 - CadViet Utility Team - www.cadviet.com
;;;========================================================

;;;----------------------------------------------------------------
(defun SepStr(S1 S / i L L1 S0 S2)
;;;Separate S to 3 segments, search by S1, from 1st position. Return list
(setq
i (vl-string-search S1 S)
L (strlen S)
L1 (strlen S1)
S0 (substr S 1 i)
S2 (substr S (+ i L1 1) (- L L1 i))
)
(list S0 S1 S2)
)
;;;----------------------------------------------------------------
(defun RemStr(S1 S / i);;;remove ALL S1 in S
(while (setq i (vl-string-search S1 S))
(setq S (strcat (car (SepStr S1 S)) (caddr (SepStr S1 S))))
)
S
)
;;;----------------------------------------------------------------
(defun LeftStr(S1 S) (car (SepStr S1 S)));;;Select Left of S1
;;;----------------------------------------------------------------
(defun RightStr(S1 S) (caddr (SepStr S1 S)));;;Select Right of S1
;;;----------------------------------------------------------------
(defun write_report(fs fr / i f1 f2 S Fn Ag Full)
(setq f1 (open fs "r") f2 (open fr "a") i 0)
(write-line (strcat ";;;;;;Search in " (strcase Fs)) f2)
(while (setq S (read-line f1))
(setq S (vl-string-trim " \t" (strcase S T)))
(if (vl-string-search ";;;;;;" S) (write-line (strcase S) f2))
(if (and (vl-string-search "defun" S) (/= (substr S 1 1) ";"))
(progn
(setq
i (1+ i)
S (rightstr "defun" S)
Fn (vl-string-trim " \t" (leftstr "(" S))
Ag (rightstr "(" S)
)
(if (vl-string-search ")" Ag) (setq Ag (leftstr ")" Ag)))
(if (vl-string-search "/" Ag) (setq Ag (leftstr "/" Ag)))
(setq Ag (vl-string-trim " \t" Ag))
(if (/= Ag "") (setq Full (strcat "(" Fn " " Ag ")")) (setq Full (strcat "(" Fn ")")))
(write-line Full f2)
)
)
);;;end while
(write-line (strcat "\n;;;;;;SUMMARY: " (itoa i) " function(s)") f2)
(write-line ";;;;;;========================================\n" f2)
(close f1)
(close f2)
(alert "Finish Report!")
)
;;;========================================
(defun C:REF( / fs fr)
(setq
fs (getfiled "Select Lisp File" "" "lsp" 4)
d (strcat (remstr ".lsp" fs) ".txt")
fr (getfiled "Append and Save Report In" d "txt" 1)
)
(if (and fs fr) (write_report fs fr))
(princ)
)
;;;========================================

  • 0