【分享明经——发程序、拜新年专贴】 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第8页

jxlsp 发表于 2009-3-11 14:43:00

本帖最后由作者于 2009-3-11 14:50:34 编辑 ;求多边形顶点列表((x1 y1)(x2 y2)(x3 y3)...)面积   (defun  lstMJ(lst / x y)    (abs      (apply '+        (mapcar '(lambda(x y)          (/(-(*(car x)(cadr y))(*(car y)(cadr x)))2.0)          )           (reverse(cdr(reverse(cons(last lst) lst))))         lst        )      )    ) )

liminnet 发表于 2009-3-27 16:43:00

caoyin大哥，你二十九楼的程序怎么你不给这个函数我啊，我现在运行起来差了一个no function definition: VLA-OBJECT->ENAME

caoyin 发表于 2009-3-27 17:10:00

网站的网页程序的关系，直接复制代码有问题<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=74564">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=74564</a>

jxphklibin 发表于 2009-3-30 10:06:00

本帖最后由作者于 2009-3-30 14:34:24 编辑

贴一个我最新写的函数，希望版主加分^_^：
从列表中移去指定的元素（一个不留，支持任意嵌套表）

;;; ============================================================================;;
;;; 函数名：       ;;
;;; RemoveItem       ;;
;;; 从列表中移去指定的元素（一个不留，支持任意嵌套表） ;;
;;; 参数：       ;;
;;; 要从列表中移去的元素和一个列表    ;;
;;; 示例：       ;;
;;; (RemoveItem nil (list 121 nil (list "abc" nil "dde" nil 111) "aaa" nil 999));;
;;; -> (121 ("abc" "dde" 111) "aaa" 999) ;;
;;; By 木子CAD工具小李子2009-3-30    ;;
;;; ============================================================================;;
(defun RemoveItem (item lst / x tmplst)
(foreach x (vl-remove item lst)
(if (listp x)
   (setq tmplst (append (list (RemoveItem item x)) tmplst))
   (setq tmplst (append (list x) tmplst))
)
)
(reverse tmplst)
)也可以这样：
;;; ============================================================================;;
;;; 函数名：       ;;
;;; RemoveItem       ;;
;;; 从列表中移去指定的元素（一个不留，支持任意嵌套表） ;;
;;; 参数：       ;;
;;; 要从列表中移去的元素和一个列表    ;;
;;; 示例：       ;;
;;; (RemoveItem nil (list 121 nil (list "abc" nil "dde" nil 111) "aaa" nil 999));;
;;; -> (121 ("abc" "dde" 111) "aaa" 999) ;;
;;; By 木子CAD工具小李子2009-3-30    ;;
;;; ============================================================================;;
(defun RemoveItem (item lst / x tmplst)
(foreach x (vl-remove item lst)
(if (listp x)
   (setq tmplst (cons (RemoveItem item x) tmplst))
   (setq tmplst (cons x tmplst))
)
)
(reverse tmplst)
)
测试结果：
;|
(RemoveItem "" (list 121 "" (list "abc" "" "dde" "" 111) "aaa" "" 999 000))
-> (121 ("abc" "dde" 111) "aaa" 999 0)
(RemoveItem "" (list 121 "" (list "abc" "" "dde" "" 111) "aaa" "" 999 000
(list 88 "" 9090 "" "" "AAA" "BBB" ""
      (list "ccc" "" "DDD" ""123)
)
)
)
-> (121 ("abc" "dde" 111) "aaa" 999 0 (88 9090 "AAA" "BBB" ("ccc" "DDD" 123)))
|;

jxphklibin 发表于 2009-4-2 08:23:00

;;;解锁所有图层
(defun UnLock_All_Layers ()
(vlax-for n (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
   )
(vla-put-lock n :vlax-false)
)
)
;;;解冻所有图层
(defun UnFreeze_All_Layers ()
(vlax-for n (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
   )
(if (/= (vla-get-name n) (getvar "clayer"))
   ;;也可以用 (not (equal (vla-get-activelayer adoc) item))判断
   (vla-put-Freeze n :vlax-false)
)
)
)

qhd_aixin 发表于 2009-4-8 00:50:00

最简洁代码为：;; 删除去除字符串中的所有空格 ;; by 小李子木子CAD 2009-3-2 (defun strs->No32 (str /)   (vl-list->string (vl-remove 32 (vl-string->list str))) )这个怎么用啊？

gangxiadexue 发表于 2009-4-14 14:58:00

感谢学习学习

飞诗(fsxm) 发表于 2009-4-24 12:08:00

<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=60071&replyID=&skin=1">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=60071&replyID=&skin=1</a>多功能表操作函数以索引 [替代/添加/删除] 表中元素,支持嵌套表! (<a href="http://www.mjtd.com/object/autolisp/defun.htm" target="_black">defun</a>
fsxm-subst-index
(lst index_lst var / subst0 subst1)    (<a href="http://www.mjtd.com/object/autolisp/defun.htm" target="_black">defun</a>
subst0
(lst index var / lst2 position)      (<a href="http://www.mjtd.com/object/autolisp/cond.htm" target="_black">cond</a>
((<a href="http://www.mjtd.com/object/autolisp/or.htm" target="_black">or</a>
(<a href="http://www.mjtd.com/object/autolisp/61.htm" target="_black">=</a> index T)
(<a href="http://www.mjtd.com/object/autolisp/62.htm" target="_black">></a> index (1-
(<a href="http://www.mjtd.com/object/autolisp/length.htm" target="_black">length</a> lst))))      (<a href="http://www.mjtd.com/object/autolisp/append.htm" target="_black">append</a> lst var)     )     ((<a href="http://www.mjtd.com/object/autolisp/6261.htm" target="_black">>=</a> index 0)      (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> position 0)      (<a href="http://www.mjtd.com/object/autolisp/while.htm" target="_black">while</a>
(<a href="http://www.mjtd.com/object/autolisp/60.htm" target="_black"><</a> position index)        (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> lst2 (<a href="http://www.mjtd.com/object/autolisp/cons.htm" target="_black">cons</a>
(<a href="http://www.mjtd.com/object/autolisp/car.htm" target="_black">car</a> lst) lst2))        (<a href="http://www.mjtd.com/object/autolisp/if.htm" target="_black">if</a>
(<a href="http://www.mjtd.com/object/autolisp/6061.htm" target="_black"><=</a> position (1- index))(<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> lst (<a href="http://www.mjtd.com/object/autolisp/cdr.htm" target="_black">cdr</a> lst)))        (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> position (<a href="http://www.mjtd.com/object/autolisp/1+.htm" target="_black">1+</a> position))      )      (<a href="http://www.mjtd.com/object/autolisp/append.htm" target="_black">append</a>
(<a href="http://www.mjtd.com/object/autolisp/reverse.htm" target="_black">reverse</a> lst2) var (<a href="http://www.mjtd.com/object/autolisp/cdr.htm" target="_black">cdr</a> lst))     )     ((<a href="http://www.mjtd.com/object/autolisp/60.htm" target="_black"><</a> index 0)      (<a href="http://www.mjtd.com/object/autolisp/append.htm" target="_black">append</a> var lst)     )      )    )    (<a href="http://www.mjtd.com/object/autolisp/defun.htm" target="_black">defun</a>
subst1
(lst index_lst var / index)      (<a href="http://www.mjtd.com/object/autolisp/if.htm" target="_black">if</a>
(<a href="http://www.mjtd.com/object/autolisp/cadr.htm" target="_black">cadr</a> index_lst)        (<a href="http://www.mjtd.com/object/autolisp/progn.htm" target="_black">progn</a>
(<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> index (<a href="http://www.mjtd.com/object/autolisp/car.htm" target="_black">car</a> index_lst))        (subst1 lst         (<a href="http://www.mjtd.com/object/autolisp/list.htm" target="_black">list</a> index)         (<a href="http://www.mjtd.com/object/autolisp/list.htm" target="_black">list</a>
(subst1 (<a href="http://www.mjtd.com/object/autolisp/nth.htm" target="_black">nth</a> index lst)
(<a href="http://www.mjtd.com/object/autolisp/cdr.htm" target="_black">cdr</a> index_lst) var))        )        )        (subst0 lst (<a href="http://www.mjtd.com/object/autolisp/car.htm" target="_black">car</a> index_lst) var)      )    )    (<a href="http://www.mjtd.com/object/autolisp/if.htm" target="_black">if</a>
(<a href="http://www.mjtd.com/object/autolisp/listp.htm" target="_black">listp</a> var) t (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> var (<a href="http://www.mjtd.com/object/autolisp/list.htm" target="_black">list</a> var)))    (<a href="http://www.mjtd.com/object/autolisp/if.htm" target="_black">if</a>
(<a href="http://www.mjtd.com/object/autolisp/listp.htm" target="_black">listp</a> index_lst) t (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> index_lst (<a href="http://www.mjtd.com/object/autolisp/list.htm" target="_black">list</a> index_lst)))    (subst1 lst index_lst var) )(<a href="http://www.mjtd.com/object/autolisp/defun.htm" target="_black">defun</a>
fsxm-subst-index
(lst index_lst var / subst0 subst1)    (<a href="http://www.mjtd.com/object/autolisp/defun.htm" target="_black">defun</a>
subst0
(lst index var / lst2 position)      (<a href="http://www.mjtd.com/object/autolisp/cond.htm" target="_black">cond</a>
((<a href="http://www.mjtd.com/object/autolisp/or.htm" target="_black">or</a>
(<a href="http://www.mjtd.com/object/autolisp/61.htm" target="_black">=</a> index T)
(<a href="http://www.mjtd.com/object/autolisp/62.htm" target="_black">></a> index (1-
(<a href="http://www.mjtd.com/object/autolisp/length.htm" target="_black">length</a> lst))))      (<a href="http://www.mjtd.com/object/autolisp/append.htm" target="_black">append</a> lst var)     )     ((<a href="http://www.mjtd.com/object/autolisp/6261.htm" target="_black">>=</a> index 0)      (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> position 0)      (<a href="http://www.mjtd.com/object/autolisp/while.htm" target="_black">while</a>
(<a href="http://www.mjtd.com/object/autolisp/60.htm" target="_black"><</a> position index)        (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> lst2 (<a href="http://www.mjtd.com/object/autolisp/cons.htm" target="_black">cons</a>
(<a href="http://www.mjtd.com/object/autolisp/car.htm" target="_black">car</a> lst) lst2))        (<a href="http://www.mjtd.com/object/autolisp/if.htm" target="_black">if</a>
(<a href="http://www.mjtd.com/object/autolisp/6061.htm" target="_black"><=</a> position (1- index))(<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> lst (<a href="http://www.mjtd.com/object/autolisp/cdr.htm" target="_black">cdr</a> lst)))        (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> position (<a href="http://www.mjtd.com/object/autolisp/1+.htm" target="_black">1+</a> position))      )      (<a href="http://www.mjtd.com/object/autolisp/append.htm" target="_black">append</a>
(<a href="http://www.mjtd.com/object/autolisp/reverse.htm" target="_black">reverse</a> lst2) var (<a href="http://www.mjtd.com/object/autolisp/cdr.htm" target="_black">cdr</a> lst))     )     ((<a href="http://www.mjtd.com/object/autolisp/60.htm" target="_black"><</a> index 0)      (<a href="http://www.mjtd.com/object/autolisp/append.htm" target="_black">append</a> var lst)     )      )    )    (<a href="http://www.mjtd.com/object/autolisp/defun.htm" target="_black">defun</a>
subst1
(lst index_lst var / index)      (<a href="http://www.mjtd.com/object/autolisp/if.htm" target="_black">if</a>
(<a href="http://www.mjtd.com/object/autolisp/cadr.htm" target="_black">cadr</a> index_lst)        (<a href="http://www.mjtd.com/object/autolisp/progn.htm" target="_black">progn</a>
(<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> index (<a href="http://www.mjtd.com/object/autolisp/car.htm" target="_black">car</a> index_lst))        (subst1 lst         (<a href="http://www.mjtd.com/object/autolisp/list.htm" target="_black">list</a> index)         (<a href="http://www.mjtd.com/object/autolisp/list.htm" target="_black">list</a>
(subst1 (<a href="http://www.mjtd.com/object/autolisp/nth.htm" target="_black">nth</a> index lst)
(<a href="http://www.mjtd.com/object/autolisp/cdr.htm" target="_black">cdr</a> index_lst) var))        )        )        (subst0 lst (<a href="http://www.mjtd.com/object/autolisp/car.htm" target="_black">car</a> index_lst) var)      )    )    (<a href="http://www.mjtd.com/object/autolisp/if.htm" target="_black">if</a>
(<a href="http://www.mjtd.com/object/autolisp/listp.htm" target="_black">listp</a> var) t (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> var (<a href="http://www.mjtd.com/object/autolisp/list.htm" target="_black">list</a> var)))    (<a href="http://www.mjtd.com/object/autolisp/if.htm" target="_black">if</a>
(<a href="http://www.mjtd.com/object/autolisp/listp.htm" target="_black">listp</a> index_lst) t (<a href="http://www.mjtd.com/object/autolisp/setq.htm" target="_black">setq</a> index_lst (<a href="http://www.mjtd.com/object/autolisp/list.htm" target="_black">list</a> index_lst)))    (subst1 lst index_lst var) )使用方法如：(setq lst '(0 1 2 (30 31 32 (330 331 332)) 4 5 6 (70 71 72) 8 9))替代 (fsxm-subst-index lst 2 "test") ->(0 1 "test" (30 31 32 (330 331 332)) 4 5 6 (70 71 72) 8 9)删除 (fsxm-subst-index lst 2 nil) ->(0 1 (30 31 32 (330 331 332)) 4 5 6 (70 71 72) 8 9)批量插入 (fsxm-subst-index lst '(3 3 0.5) '("test1" "test2")) ->(0 1 2 (30 31 32 (330 "test1" "test2" 331 332)) 4 5 6 (70 71 72) 8 9)

caoyin 发表于 2009-4-24 13:21:00

fsxm发表于2009-4-24 12:08:00static/image/common/back.gifhttp://bbs.mjtd.com/forum.php?mod=viewthread&tid=60071&replyID=&skin=1............. 

高手来了，多贴点东西让咱学习一下噻！！

飞诗(fsxm) 发表于 2009-4-26 19:36:00

caoyin老大,"高手"两字不敢当啊~!
潜水多年了,Lisp也忘记的差不多了!
只能多拿出点以前的老本,给老大你捧场哈!
;;建立目录.支持嵌套目录名.(递归的简单运用)
(defun fsxm-mkdir (dir / dir2)
(cond ((vl-directory-files dir))
((= (setq dir2 (vl-filename-directory dir)) dir) nil)
(t (fsxm-mkdir dir2) (vl-mkdir dir))
)
)1.如果目录名存在,就返回目录内所有文件名.
如:(fsxm-mkdir "c:\\windows")
2.如果建立失败就返回nil.
如:(fsxm-mkdir "c:")
3.如果成功就返回T.
如: (fsxm-mkdir "c:\\1\\2\\3\\4\\5\\6\\7\\8\\9")

页: 1 2 3 4 5 6 7 [8] 9 10 11 12 13 14 15

明经CAD社区's Archiver