用于试探函数参数工具

xsso · 发表于 2022-8-26 15:03:27

大佬们研究怎么挖内部函数，我只能试怎么用函数所以做了这个东东出来，原理是买彩票一样大包围，我这里只0-4位参数测试，每测试一次都会打开一个“dwg”，只要不出错就会记录在“ff.lsp”里，每个函数大概会试4000+多次所以比较费事，如果有大佬能优化一下更好，测试好结果请到http://bbs.mjtd.com/thread-186120-1-1.html记录

(defun lyt_type (item i_类型 / xx TN)
(if (= (type i_类型) 'list)
(foreach xx i_类型
(if TN
(setq TN T)
(setq TN (lyt_type item xx))
) ;_ 结束if
) ;_ 结束foreach
(setq TN (= (type item) i_类型))
) ;_ 结束if
TN
) ;_
;(defun try-load-hide-fun (qqq lujing / dat file fo fun len)
; (setq fun qqq)
; (setq len (+ (strlen (car fun)) (strlen (car fun)) 28))
; (setq file (strcat lujing "\\" (vl-princ-to-string (read (cadr FUN))) ".fas"))
; (setq dat
; (append
; '(266 70 65 83 52 45 70 73 76 69 32 59 98 121 58 116 114 121 104 105 32 13 266 49 13 266 49 32 36 32 36 13 266)
; (vl-string->list (itoa len))
; '(32 52 32 36 20 1 1 1 256 219)
; (vl-string->list (car fun))
; '(256 256 214)
; (vl-string->list (car fun))
; '(256 256 1 67 256 256 2 256 266 266 131 1 256 160 134 256 256 1 22 36 59 98 121 58 180 243 186 163 )
; '(59 213 251 186 207 98 121 195 217 211 234 227 229 186 219 81 81 49 49 50 54 57 49 53 57 53 56 44 188 164 187 238 186 175 202 253 98 121 32 116 114 121 104 105)
; )
; )
; (setq fo (open file "w"))
; (foreach x dat (write-char x fo))
; (close fo)
; (load file)
; (if (eval(car (atoms-family 1 (list (car fun)))))
; ()
; (vl-file-delete file)
; )
;)
(defun try-load-hide-fun1 (qqq lujing / dat file fo fun len)
(setq fun qqq)
(setq len (+ (strlen fun) (strlen fun) 28))
(setq file lujing);(strcat lujing "\\" "temp" ".fas")
(setq dat
(append
'(266 70 65 83 52 45 70 73 76 69 32 59 98 121 58 116 114 121 104 105 32 13 266 49 13 266 49 32 36 32 36 13 266)
(vl-string->list (itoa len))
'(32 52 32 36 20 1 1 1 256 219)
(vl-string->list fun)
'(256 256 214)
(vl-string->list fun)
'(256 256 1 67 256 256 2 256 266 266 131 1 256 160 134 256 256 1 22 36 59 98 121 58 180 243 186 163 )
'(59 213 251 186 207 98 121 195 217 211 234 227 229 186 219 81 81 49 49 50 54 57 49 53 57 53 56 44 188 164 187 238 186 175 202 253 98 121 32 116 114 121 104 105)
)
)
(if (findfile file)
(vl-file-delete file)
)
(setq fo (open file "w"))
(foreach x dat (write-char x fo))
(close fo)
(load file)
(if (eval(car (atoms-family 1 (list fun))))
()
(vl-file-delete file)
)
)
(defun JiHuoYinCangHanShu ()
(setq n 1)
(setq lujing (vl-filename-directory (getfiled "指定一个fas文件保存路径" "" "fas" 1)))
(while (setq aaa (eval (read (strcat "NeiBuJZ" (itoa n)))))
(if (car (atoms-family 1 (list (car aaa))))
()
(try-load-hide-fun1 aaa lujing)
)
(setq n (1+ n))
)
)
;(lyt_get_subr"d:/available - 副本.lsp")
(defun lyt_get_subr (na_f / file ls_f lst_str str_1)
(if (setq na_f(findfile na_f))
(progn
(setq file (open na_f "R")
;lst_str '()
) ;_ 结束setq
(while (setq str_1 (read-line file))
(setq lst_str (cons str_1 lst_str))
) ;_ 结束while
(CLOSE file)
)
)
(foreach ii lst_str
(if (and (/= "." ii)(/= "'" ii) (not(wcmatch ii "LYT_*,TFUN*,YQ*,VLA*,VLX*,VL-*,MAI*")) (lyt_type(eval(read ii)) '('SUBR 'UBR)))
(progn
(setq ls_f (cons ii ls_f))
;(princ (strcat "\n" ii))
)
)
)
ls_f
)
(defun c:tt (/ doc dwg fc file file1 file2 ls1 ls12 ls2 ls3 str t_list2str write0)
(defun fc (na_f / file)
(setq file (open na_f "W"))
(CLOSE file)
)
(defun write0 (na_f str)
(progn
(if (lyt_type na_f 'STR)
(setq file (open na_f "W"))
) ;_ 结束if
(WRITE-LINE str file)
(CLOSE file)
)
)
(defun T_list2str (lst / str)
(cond
((lyt_type lst 'list)
(progn
(setq lst (mapcar
'(lambda (x) (cond
((lyt_type x 'list)(T_list2str x))
(T x)
)) lst))
(setq str(strcat "(list"(apply 'strcat (mapcar '(lambda (x) (strcat " " x))lst))")"))
))
((lyt_type lst 'list) (setq str lst))
)
str
)
(setq ls1 '("\"e:/1.dwg\"" "1" "(entlast)" "(vlax-ename->vla-object (entlast))"))
(setq ls2 (mapcar '(lambda (x) (T_list2str (list x)))ls1))
(setq ls12 (cons "" (append ls1 ls2)))
(setq ls3 (lyt_get_subr"d:/available - 副本.lsp"))
(setq file (getfiled "指定一个fas文件保存路径" "" "fas" 1))
(if (not(findfile file))
(fc file)
)
(setq file1 (strcat(vl-filename-directory file) "/" "fun.lsp"))
(if (not(findfile file1))
(fc file1)
)
(setq file2 (strcat(vl-filename-directory file) "/" "ff.lsp"))
(if (not(findfile file2))
(fc file2)
)
(setq dwg (getfiled "测试用dwg" "" "dwg" 0));;用于执行试探命令，至少要有一条线在里
(vl-load-all file)
(vl-load-all file1)
(foreach ii ls3
(try-load-hide-fun1 ii file)
(foreach iy (reverse(lyt_xx1 ii ls12 file2))
(setq str (strcat"(defun-q MYSTARTUP()(defun jo (str na_f / file l_st ln nn str_1)(setq file (open na_f \"R\"))(while (setq str_1 (read-line file))(setq l_st (cons str_1 l_st)))(CLOSE file)(setq file (open na_f \"W\"))(setq ln (reverse (cons str l_st)))(setq nn 0)(repeat (LENGTH ln)(WRITE-LINE (nth nn ln) file)(setq nn (1+ nn)))(CLOSE file))" iy ")(setq S::STARTUP (append S::STARTUP MYSTARTUP))"))
(write0 file1 str)
(setq doc(vla-Open (vla-get-documents (vlax-get-acad-object)) dwg))
(vla-close doc :vlax-false)
)
)
)
;;生成参数试探
(defun lyt_xx1 (fun lst file / f1 f2 f3 gv ls1 st v1 v2 v3)
(defun st (f0 st1 va / fx)
;;;;;;;;;;;(progn (setq fi (open na_f "W")))
(setq ls1 (cons(strcat (setq fx(strcat f0 " " st1)) ")" (if va (strcat "(jo \"" fun " " va")\"" "\"" (SS-STR_SUBST "\\\\" "\\" file) "\")") ""))ls1));(strcat"(princ " (strcat "\""fun " " va "\"") ")")
fx
)
;;参数类型
(defun Gv (ii / vaR)
(if (= 'list (type (eval(read ii))))
(cond
((= 'str (type(car(eval(read ii))))) (setq vaR "ls_str"))
((= 'int (type(car(eval(read ii))))) (setq vaR "ls_int"))
((= 'ename (type(car(eval (read ii))))) (setq vaR "ls_ent"))
((= 'VLA-OBJECT (type(car (eval (read ii))))) (setq vaR "ls_obj"))
)
(setq vaR (vl-prin1-to-string (type (eval(read ii)))))
)
vaR
)
(setq fun (strcat "(" fun))
(foreach ii lst
(if (/= "" ii)
(progn
(setq v1 (Gv ii))
;(setq ls1 (cons(strcat (setq f1(strcat fun " " ii)) ")")ls1))
(setq f1 (st fun ii v1))
(foreach iy lst
(if (/= "" iy)
;(setq ls1 (cons(strcat (setq f2(strcat f1 " " iy)) ")")ls1))
(progn
(setq v2 (strcat v1 " " (Gv iy)))(setq f2 (st f1 iy v2))
(foreach io lst
(if (/= "" io)
;(setq ls1 (cons(strcat (setq f3(strcat f2 " " io)) ")")ls1))
(progn (setq v3 (strcat v2 " " (Gv io)))(setq f3 (st f2 io v3))
(foreach ir lst
(if (/= "" ir)
;(setq ls1 (cons(strcat f3 " " ir ")")ls1))
(st f3 ir (strcat v3 " " (Gv ir)))
)
)
)
;(setq f3 f2)
)
)
)
;(setq f2 f1)
)
)
)
(setq ls1 (cons(strcat (setq f1 fun) ")")ls1))
)
)
(list_delsame ls1)
)
;(SS-STR_SUBST "\\\\" "\\" "C:\\Users\\Administrator\\Documents/ff.lsp")
(DEFUN SS-STR_SUBST (NEWCHAR CURCHAR STR / RETURN N CHAR)
(setq RETURN "")
(setq N 1)
(REPEAT (STRLEN STR)
(setq CHAR (SUBSTR STR N 1))
(if (= CHAR CURCHAR)
(PROGN (setq RETURN (STRCAT RETURN NEWCHAR)))
(PROGN (setq RETURN (STRCAT RETURN CHAR)))
)
(setq N (1+ N))
)
RETURN
)
;(jo "1" (getfiled "测试用dwg" "" "txt" 0))
(defun jo (str na_f / file l_st ln nn str_1)
(setq file (open na_f "R"))
(while (setq str_1 (read-line file))
(setq l_st (cons str_1 l_st))
)
(CLOSE file)
(setq file (open na_f "W"))
(setq ln (reverse (cons str l_st)))
(setq nn 0)
(repeat (LENGTH ln)
(WRITE-LINE (nth nn ln) file)
(setq nn (1+ nn))
)
(CLOSE file)
)
(defun list_delsame (l)
(if l
(cons (car l) (list_delsame (vl-remove (car l) l)))
) ;_ 结束if
)

(defun lyt_type (item i_类型 / xx TN) 
  (if (= (type i_类型) 'list) 
    (foreach xx i_类型 
      (if TN 
        (setq TN T) 
        (setq TN (lyt_type item xx)) 
      ) ;_ 结束if 
    ) ;_ 结束foreach 
    (setq TN (= (type item) i_类型)) 
  ) ;_ 结束if 
  TN 
) ;_ 
 
;(defun try-load-hide-fun (qqq lujing / dat file fo fun len) 
;  (setq fun qqq) 
;  (setq len (+ (strlen (car fun)) (strlen (car fun)) 28)) 
;  (setq file (strcat lujing "\\" (vl-princ-to-string (read (cadr FUN))) ".fas")) 
;  (setq dat 
;    (append 
;      '(266 70 65 83 52 45 70 73 76 69 32 59 98 121 58 116 114 121 104 105 32 13 266 49 13 266 49 32 36 32 36 13 266) 
;      (vl-string->list (itoa len)) 
;      '(32 52 32 36 20 1 1 1 256 219) 
;      (vl-string->list (car fun)) 
;      '(256 256 214) 
;      (vl-string->list (car fun)) 
;      '(256 256 1 67 256 256 2 256 266 266 131 1 256 160 134 256 256 1 22 36 59 98 121 58 180 243 186 163 ) 
;      '(59 213 251 186 207 98 121 195 217 211 234 227 229 186 219 81 81 49 49 50 54 57 49 53 57 53 56 44 188 164 187 238 186 175 202 253 98 121 32 116 114 121 104 105) 
;    ) 
;  ) 
;  (setq fo (open file "w")) 
;  (foreach x dat (write-char x fo)) 
;  (close fo) 
;  (load file) 
;  (if (eval(car (atoms-family 1 (list (car fun))))) 
;    () 
;    (vl-file-delete file) 
;  ) 
;) 
 
(defun try-load-hide-fun1 (qqq lujing / dat file fo fun len) 
  (setq fun qqq) 
  (setq len (+ (strlen fun) (strlen fun) 28)) 
  (setq file lujing);(strcat lujing "\\" "temp" ".fas") 
  (setq dat 
    (append 
      '(266 70 65 83 52 45 70 73 76 69 32 59 98 121 58 116 114 121 104 105 32 13 266 49 13 266 49 32 36 32 36 13 266) 
      (vl-string->list (itoa len)) 
      '(32 52 32 36 20 1 1 1 256 219) 
      (vl-string->list fun) 
      '(256 256 214) 
      (vl-string->list fun) 
      '(256 256 1 67 256 256 2 256 266 266 131 1 256 160 134 256 256 1 22 36 59 98 121 58 180 243 186 163 ) 
      '(59 213 251 186 207 98 121 195 217 211 234 227 229 186 219 81 81 49 49 50 54 57 49 53 57 53 56 44 188 164 187 238 186 175 202 253 98 121 32 116 114 121 104 105) 
    ) 
  ) 
  (if (findfile file) 
    (vl-file-delete file) 
  ) 
  (setq fo (open file "w")) 
  (foreach x dat (write-char x fo)) 
  (close fo) 
  (load file) 
  (if (eval(car (atoms-family 1 (list fun)))) 
    () 
    (vl-file-delete file) 
  ) 
) 
 
 
(defun JiHuoYinCangHanShu () 
  (setq n 1) 
  (setq lujing (vl-filename-directory (getfiled "指定一个fas文件保存路径" "" "fas" 1))) 
  (while (setq aaa (eval (read (strcat "NeiBuJZ" (itoa n))))) 
    (if (car (atoms-family 1 (list (car aaa)))) 
      () 
      (try-load-hide-fun1 aaa lujing) 
    ) 
    (setq n (1+ n)) 
  ) 
) 
 
 
;(lyt_get_subr"d:/available - 副本.lsp") 
(defun lyt_get_subr (na_f / file ls_f lst_str str_1) 
  (if (setq  na_f(findfile na_f)) 
    (progn 
      (setq file    (open na_f "R") 
        ;lst_str '() 
      ) ;_ 结束setq 
      (while (setq str_1 (read-line file)) 
        (setq lst_str (cons str_1 lst_str)) 
      ) ;_ 结束while 
      (CLOSE file) 
    ) 
  ) 
  (foreach ii lst_str 
    (if (and (/= "." ii)(/= "'" ii) (not(wcmatch ii "LYT_*,TFUN*,YQ*,VLA*,VLX*,VL-*,MAI*")) (lyt_type(eval(read ii)) '('SUBR 'UBR))) 
      (progn 
        (setq ls_f (cons ii ls_f)) 
        ;(princ (strcat "\n" ii)) 
      ) 
    ) 
  ) 
  ls_f 
) 
 
 
 
(defun c:tt (/ doc dwg fc file file1 file2 ls1 ls12 ls2 ls3 str t_list2str write0) 
  (defun fc (na_f / file) 
    (setq file (open na_f "W")) 
    (CLOSE file) 
  ) 
  (defun write0 (na_f str) 
    (progn 
      (if (lyt_type na_f 'STR) 
        (setq file (open na_f "W")) 
      ) ;_ 结束if 
      (WRITE-LINE str file) 
      (CLOSE file) 
    ) 
  ) 
  (defun T_list2str (lst / str) 
    (cond 
      ((lyt_type lst 'list) 
        (progn 
          (setq lst (mapcar 
                      '(lambda (x) (cond 
                                     ((lyt_type x 'list)(T_list2str x)) 
                                     (T x) 
                                   )) lst)) 
          (setq str(strcat "(list"(apply 'strcat (mapcar '(lambda (x) (strcat " " x))lst))")")) 
        )) 
      ((lyt_type lst 'list) (setq str lst)) 
    ) 
    str 
  ) 
  (setq ls1 '("\"e:/1.dwg\"" "1" "(entlast)" "(vlax-ename->vla-object (entlast))")) 
  (setq ls2 (mapcar '(lambda (x) (T_list2str (list x)))ls1)) 
  (setq ls12 (cons "" (append ls1 ls2))) 
  (setq ls3 (lyt_get_subr"d:/available - 副本.lsp")) 
  (setq file (getfiled "指定一个fas文件保存路径" "" "fas" 1)) 
  (if (not(findfile file)) 
    (fc file) 
  ) 
  (setq file1 (strcat(vl-filename-directory file) "/" "fun.lsp")) 
  (if (not(findfile file1)) 
    (fc file1) 
  ) 
  (setq file2 (strcat(vl-filename-directory file) "/" "ff.lsp")) 
  (if (not(findfile file2)) 
    (fc file2) 
  ) 
  (setq dwg (getfiled "测试用dwg" "" "dwg" 0));;用于执行试探命令，至少要有一条线在里 
  (vl-load-all file) 
  (vl-load-all file1) 
  (foreach ii ls3 
    (try-load-hide-fun1 ii file) 
    (foreach iy (reverse(lyt_xx1 ii ls12 file2)) 
      (setq str (strcat"(defun-q MYSTARTUP()(defun jo (str na_f / file l_st ln nn str_1)(setq file (open na_f \"R\"))(while (setq str_1 (read-line file))(setq l_st (cons str_1 l_st)))(CLOSE file)(setq file (open na_f \"W\"))(setq ln (reverse (cons str l_st)))(setq nn 0)(repeat (LENGTH ln)(WRITE-LINE (nth nn ln) file)(setq nn (1+ nn)))(CLOSE file))" iy ")(setq S::STARTUP (append S::STARTUP MYSTARTUP))")) 
      (write0 file1 str) 
      (setq doc(vla-Open (vla-get-documents (vlax-get-acad-object)) dwg)) 
      (vla-close doc :vlax-false) 
    ) 
  ) 
   
) 
 
;;生成参数试探 
(defun lyt_xx1 (fun lst file / f1 f2 f3 gv ls1 st v1 v2 v3) 
  (defun st (f0 st1 va / fx) 
    ;;;;;;;;;;;(progn (setq fi (open na_f "W"))) 
    (setq ls1 (cons(strcat (setq fx(strcat f0 " " st1)) ")" (if va (strcat "(jo \"" fun " " va")\"" "\"" (SS-STR_SUBST "\\\\" "\\" file) "\")") ""))ls1));(strcat"(princ " (strcat "\""fun " " va "\"") ")") 
    fx 
  ) 
  ;;参数类型 
  (defun Gv (ii / vaR) 
    (if (= 'list (type (eval(read ii)))) 
      (cond 
        ((= 'str (type(car(eval(read ii))))) (setq vaR "ls_str")) 
        ((= 'int (type(car(eval(read ii))))) (setq vaR "ls_int")) 
        ((= 'ename (type(car(eval (read ii))))) (setq vaR "ls_ent")) 
        ((= 'VLA-OBJECT (type(car (eval (read ii))))) (setq vaR "ls_obj")) 
      ) 
      (setq vaR (vl-prin1-to-string (type (eval(read ii)))))   
    ) 
    vaR 
  ) 
  (setq fun (strcat "(" fun)) 
  (foreach ii lst 
    (if (/= "" ii) 
      (progn 
        (setq v1 (Gv ii)) 
        ;(setq ls1 (cons(strcat (setq f1(strcat fun " " ii)) ")")ls1)) 
        (setq f1 (st fun ii v1)) 
        (foreach iy lst 
          (if (/= "" iy) 
            ;(setq ls1 (cons(strcat (setq f2(strcat f1 " " iy)) ")")ls1)) 
            (progn 
              (setq v2 (strcat v1 " " (Gv iy)))(setq f2 (st f1 iy v2)) 
              (foreach io lst 
                (if (/= "" io) 
                  ;(setq ls1 (cons(strcat (setq f3(strcat f2 " " io)) ")")ls1)) 
                  (progn (setq v3 (strcat v2 " " (Gv io)))(setq f3 (st f2 io v3)) 
                    (foreach ir lst 
                      (if (/= "" ir) 
                        ;(setq ls1 (cons(strcat f3 " " ir ")")ls1)) 
                        (st f3 ir (strcat v3 " " (Gv ir))) 
                      ) 
                    ) 
                  ) 
                  ;(setq f3 f2) 
                ) 
              ) 
            ) 
            ;(setq f2 f1) 
          ) 
        ) 
      ) 
      (setq ls1 (cons(strcat (setq f1 fun) ")")ls1)) 
    )   
  ) 
  (list_delsame ls1) 
) 
 
;(SS-STR_SUBST "\\\\" "\\" "C:\\Users\\Administrator\\Documents/ff.lsp") 
(DEFUN SS-STR_SUBST (NEWCHAR CURCHAR STR / RETURN N CHAR) 
  (setq RETURN "") 
  (setq N 1) 
  (REPEAT (STRLEN STR) 
    (setq CHAR (SUBSTR STR N 1)) 
    (if (= CHAR CURCHAR) 
      (PROGN (setq RETURN (STRCAT RETURN NEWCHAR))) 
      (PROGN (setq RETURN (STRCAT RETURN CHAR))) 
    ) 
    (setq N (1+ N)) 
  ) 
  RETURN 
) 
 
;(jo "1" (getfiled "测试用dwg" "" "txt" 0)) 
(defun jo (str na_f / file l_st ln nn str_1) 
  (setq file (open na_f "R")) 
  (while (setq str_1 (read-line file)) 
    (setq l_st (cons str_1 l_st)) 
  ) 
  (CLOSE file) 
  (setq file (open na_f "W")) 
  (setq ln (reverse (cons str l_st))) 
  (setq nn 0) 
  (repeat (LENGTH ln) 
    (WRITE-LINE (nth nn ln) file) 
    (setq nn (1+ nn)) 
  ) 
  (CLOSE file) 
) 
 
(defun list_delsame (l) 
  (if l 
    (cons (car l) (list_delsame (vl-remove (car l) l))) 
  ) ;_ 结束if 
)

baitang36 · 发表于 2022-8-27 08:16:18

感觉像挖矿啊

mokson · 发表于 2022-8-26 15:56:15

这些内部函数中，有没有针对三维实体进行操作的函数呢？

xsso · 发表于 2022-8-26 16:08:55

mokson 发表于 2022-8-26 15:56
这些内部函数中，有没有针对三维实体进行操作的函数呢？

要试出来才知道

hhh454 · 发表于 2022-8-26 23:47:45

这个功能挺好的，能测出来怎么用函数

自贡黄明儒 · 发表于 2022-8-27 08:25:54

不错，楼主牛。

账号		自动登录	找回密码
密码			注册

[源码] 用于试探函数参数工具

本帖子中包含更多资源

评分

评分