各位帮忙修改命令!

寒风

附件中为压缩包，在压缩包的注释中有命令修改要求
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-12 12:16
1.第一个功能是polyline的简化，搜索后我们发现weed.lsp（见附件）完全满足我们对于线的形态简化的需要（该 ...

第三个你所述的最长的线上的交点比较模糊，至少左右两图中不能看到明显的最长的线的交点

革天明

现在是第三个程序，对你你的样例可以实现，你也可以看我的图片，只要交点就是直线端点的直线（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
)
;;;----通用函数-----
;;carrot1983  http://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
1.第一个功能是polyline的简化，搜索后我们发现weed.lsp（见附件）完全满足我们对于线的形态简化的需要（该 ...

如果能看得懂我写的第三个程序的话，第二个就很简单了