各位帮忙修改命令!
本帖最后由 寒风 于 2012-9-12 12:32 编辑附件中为压缩包，在压缩包的注释中有命令修改要求
lisp是从网上找到的，两个需要修改，一个需要编写！
谢谢
1.第一个功能是polyline的简化，搜索后我们发现weed.lsp（见附件）完全满足我们对于线的形态简化的需要（该lsp采用的是控制vertex偏移简化线距离和线段长度两个变量来得到简化的polyline），但可惜的是weed.lsp一次只能选择一条polyline处理，并且不能处理lwpolyline;我们需要在这两个方面进行改进； 2.第二个功能是直线的自动延伸；也找到了和我们的需求差不多的lisp（见附件的blen.lsp，自动从直线的两个端点延长设定的距离)，；我们需要对blen.lsp改进，只有当一个直线的端点同时还是该直线与其它直线的交点的时候，才从该端点延长直线；否则不延长（见附件lengthen intersection points.dwg）。 3.第三个功能完全没有参考的lisp，功能需求是将邻近的交点进行合并或焊接（welding）：（见附件merge neighboring intersection points.dwg），当一个交点与其它交点的距离小于设定值的时候，将这些交点合并为一个（以位于最长的线上的交点为锚点，锚点位置不变，其它交点向其合并）。 1.第一个功能是polyline的简化，搜索后我们发现weed.lsp（见附件）完全满足我们对于线的形态简化的需要（该lsp采用的是控制vertex偏移简化线距离和线段长度两个变量来得到简化的polyline），但可惜的是weed.lsp一次只能选择一条polyline处理，并且不能处理lwpolyline;我们需要在这两个方面进行改进；
2.第二个功能是直线的自动延伸；也找到了和我们的需求差不多的lisp（见附件的blen.lsp，自动从直线的两个端点延长设定的距离)，；我们需要对blen.lsp改进，只有当一个直线的端点同时还是该直线与其它直线的交点的时候，才从该端点延长直线；否则不延长（见附件lengthen intersection points.dwg）。
3.第三个功能完全没有参考的lisp，功能需求是将邻近的交点进行合并或焊接（welding）：（见附件merge neighboring intersection points.dwg），当一个交点与其它交点的距离小于设定值的时候，将这些交点合并为一个（以位于最长的线上的交点为锚点，锚点位置不变，其它交点向其合并）。 没人帮忙一下吗？ 本帖最后由 革天明 于 2012-9-19 13:13 编辑
寒风 发表于 2012-9-12 12:16 static/image/common/back.gif
1.第一个功能是polyline的简化，搜索后我们发现weed.lsp（见附件）完全满足我们对于线的形态简化的需要（该 ...
第三个你所述的最长的线上的交点比较模糊，至少左右两图中不能看到明显的最长的线的交点
本帖最后由 革天明 于 2012-9-19 16:29 编辑
现在是第三个程序，对你你的样例可以实现，你也可以看我的图片，只要交点就是直线端点的直线（1e-6的精度）都可以自动找到交点不是线的端点的位置进行合并 ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;功能:返回两个对象的所有交点
;;参数: ent1、ent2 均为ename对象
(defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(vl-load-com)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
ax_ent_2 (vlax-ename->vla-object ent2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(repeat (/ (+ 1
(- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
)
3
)
(setq points
(append
points
(list (list
(vlax-safearray-get-element intpoints i)
(vlax-safearray-get-element intpoints (+ i 1))
(vlax-safearray-get-element intpoints (+ i 2))
)
)
)
)
(setq i (+ 3 i))
)
)
points
)
;;;----通用函数-----
;;carrot1983http://bbs.mjtd.com/forum.php?mod=viewthread&tid=64502
;;选择集->图元名表
(defun ss->elst (ss / elst)
(setq i 0)
(repeat (sslength ss)
(setq elst (cons (ssname ss i) elst)
i (1+ i)
)
)
(reverse elst)
)
;;翻译了rosettacode的一段递归代码
;;若各位有兴致的话，也可以看看 Reini Urban（STDLIB作者）的函数
;;http://autocad.xarch.at/stdlib/COMBINATIONS.LSP
;;;from http://rosettacode.org/wiki/Combinations#Scheme
;;;translated into autolisp by qjchen
(defun combination (lst m)
(cond ((zerop m) '(()))
((null lst) '())
(T
(append (mapcar '(lambda (y) (cons (car lst) y))
(combination (cdr lst) (- m 1))
)
(combination (cdr lst) m)
)
)
)
)
;;(combination '(5 1 2 3 4) 1)
(defun c:test1 ()
(setq ss (ssget '((0 . "LINE"))))
(if ss
(progn
;;将选择集转化成对象名组成的表
(setq ssnamelist (ss->elst ss))
;;将对象名表按2个一组进行组合
(setq PXlist (combination ssnamelist 2))
;;求两个对象的交点点，不包括虚交点
(setq JDlist
(mapcar '(lambda (x)
(car x)
)
(vl-remove nil
(mapcar '(lambda (x)
(obj_int (car x) (cadr x))
)
PXlist
)
)
)
)
;;线的起点10与终点11
(setq 1011list (append (mapcar '(lambda (x)
(cdr (assoc 10 (entget x)))
)
ssnamelist
)
(mapcar '(lambda (x)
(cdr (assoc 11 (entget x)))
)
ssnamelist
)
)
)
(setq i 0)
(repeat (length JDlist)
(setq JDpt(nth i JDlist))
(if (= (length
(vl-remove
nil
(mapcar
'(lambda (x)
(equal JDpt x 1e-6)
)
1011list
)
)
)
0
)
(setq pt0 JDpt)
)
(setq i (1+ i))
)
(if (null pt0)
(setq pt0(getpoint "\n请输入基准交点："))
)
(setq i 0)
(repeat (length ssnamelist)
(setq ssname1 (nth i ssnamelist))
(if
(> (length
(vl-remove
nil
(mapcar
'(lambda (x)
(equal (cdr (assoc 10 (entget ssname1))) x 1e-6)
)
JDlist
)
)
)
0
)
(progn
(setq endata (entget ssname1))
(setq old10list (assoc 10 (entget ssname1)))
(setq new10list (cons 10 pt0))
(setq endata (subst new10list old10list endata))
(entmod endata)
)
)
(if
(> (length
(vl-remove
nil
(mapcar
'(lambda (x)
(equal (cdr (assoc 11 (entget ssname1))) x 1e-6)
)
JDlist
)
)
)
0
)
(progn
(setq endata (entget ssname1))
(setq old11list (assoc 11 (entget ssname1)))
(setq new11list (cons 11 pt0))
(setq endata (subst new11list old11list endata))
(entmod endata)
)
)
(setq i (1+ i))
)
;;end repeat
)
;;end progn
)
;;end if
)
真的谢谢你! 寒风 发表于 2012-9-12 12:16 static/image/common/back.gif
1.第一个功能是polyline的简化，搜索后我们发现weed.lsp（见附件）完全满足我们对于线的形态简化的需要（该 ...
如果能看得懂我写的第三个程序的话，第二个就很简单了