[必看]：求一个LISP源程序

tc405003

我想找一个LISP程序，如：点取12-34-60会自动分解字符串，并提取最大值60

风如水

呵呵，搞结构的吧?

nyp

我也是搞结构的，我也在找这方面资料，希望找到一起分享！

feye

是桥梁的吧

tc405003

看来这里也不怎么样，发了这么久，根本没有人解决问题

krjcxc321

这要求没想过,也不知为什么要用这种功能,能否说一下?

tc405003

我是做结构的，就是想把PKPM输出的配筋值46-9-0在图上点取，并取出最大值49，然后就可以编辑了

jjgfsj

我也想要啊

Underway

;;; ================================================================
;;; helper function

     ;; STRTOK  - break strng on char if it's in chs (char-string).
     ;; Like "C" strtok() break string to tokens delimited by one
     ;;   OR MORE chars.
     ;; parse free format -- no empty tokens --
     ;;   (strtok " 1,,  2,  3," " ,")->{"1" "2" "3"}

    (defun strtok (strng chs / len c l s cnt chsl )
       (setq chsl (strtol chs))
       (setq len (strlen strng) s "" cnt (1+ len))
       (while (> (setq cnt (1- cnt)) 0)
         (setq c (substr strng cnt 1))
         (if (member c chsl)
           (if (strp s)
             (setq l (cons s l) s "")
           )
           (setq s (strcat c s))
         )
       )
       (if (strp s)
         (cons s l)
         l
       )
    )

    ;;
     ;; (C.) 1996 by Vladimir Nesterovsky
     ;; USE THESE FUNCTIONS FOR ANY NON-PROFITABLE PURPOSE WHILE
     ;; KEEPING THIS NOTICE. NO WARRANTIES ARE GIVEN WHATSOEVER.
     ;;

     ;; strtol convert string of chars into list of 1-char strings

    (defun strtol ( s / lst c )
       (repeat (setq c (strlen s))
         (Setq lst (cons (substr s c 1) lst)
                 c (1- c)
       ))
       lst
    )
   
    (defun strp (s) (and (= 'STR (type s)) (/= s "")))
    (defun dxg (code ele)
      (cdr (assoc code (entget ele)))
    )
   
;;; Main Function
;;; just for test
;;; no error trap

  (defun C:test ()
     (while (setq str (entsel))
       (terpri)  
       (princ (apply 'max (mapcar 'read (strtok (dxg 1 (car str)) "-")))))
       (terpri)
     )
     (prin1)
  )   
         
;;; code end here

tc405003

谢谢楼主把我问题解决了，很好

fhqgokd

谢谢拉！我找的也是这个源程序，！不错。

冯小小小

找了挺久了！

stoneball

如此简单的程序为什么不自己动手呢，资源共享是好事，但还是应该经常自己写东西的，不能都复制、粘贴————〉over