多段线自动伸缩，有谁帮忙解决一下好吗？

soly2006 · 发表于 2013-7-8 14:21

本帖最后由 soly2006 于 2013-7-8 19:11 编辑

如下图，有时红线调整后，与红线紧密相接的白线会出现不够（缝隙）或超出（相交），有什么办法自动处理掉给定不够或超出一定长度多段线（比如说0.01），使之能齐平。

zyhandw · 发表于 2013-7-9 09:45

晓东上倒是有比较类似的，可以参考下（不过源程序是针对直线的）：http://www.xdcad.net/forum/forum ... read&tid=489936

zyhandw · 发表于 2013-7-9 09:47

看来，楼主应该也是搞测绘或GIS的

carrottj · 发表于 2013-7-11 19:36

soly2006 · 发表于 2013-7-12 09:50

carrottj 发表于 2013-7-11 19:36

GOOD，能不能共享代码？谢谢！

carrottj · 发表于 2013-7-24 11:53

soly2006 发表于 2013-7-12 09:50
GOOD，能不能共享代码？谢谢！

没有源码，别人的工具

Andyhon · 发表于 2013-7-24 12:32

本帖最后由 Andyhon 于 2013-7-24 12:38 编辑

Ref:

(defun c:xtnd (/ e n s x b b1 b2 d1 d2 p1 p2)
;; (setvar 'OsMode 0)
;; (command "undo" "m")
(while (= b nil) (setq b (car (entsel "\nSelect baundary edge ....."))))
(while b
(redraw b 3)
(setq b1 (cdr (assoc 10 (entget b)))
b2 (cdr (assoc 11 (entget b)))
)
(princ "\nSelect objects to extend ; >> same side a group ..... ")
(while (= s nil) (setq s (ssget)))
(setq n (sslength s))
(while (> n 0)
(setq e (entget (ssname s (setq n (1- n))))
p1 (cdr (assoc 10 e)) p2 (cdr (assoc 11 e))
x (inters p1 p2 b1 b2 nil)
)
(if x (progn
(setq d1 (distance x p1) d2 (distance x p2))
(if (> d2 d1)
(entmod (subst (cons 10 x) (assoc 10 e) e))
(entmod (subst (cons 11 x) (assoc 11 e) e))
) ) ) )
(redraw b)
(setq b (car (entsel "\nSelect baundary edge .....")) s nil)
)
;; (setvar 'OsMode 167)
)

(defun c:xtnd (/ e n s x b b1 b2 d1 d2 p1 p2) 
;; (setvar 'OsMode 0) 
;; (command "undo" "m") 
    (while (= b nil) (setq b (car (entsel "\nSelect baundary edge .....")))) 
    (while b 
      (redraw b 3) 
      (setq b1 (cdr (assoc 10 (entget b))) 
            b2 (cdr (assoc 11 (entget b))) 
      )       
      (princ "\nSelect objects to extend ; >> same side a group ..... ") 
      (while (= s nil) (setq s (ssget))) 
      (setq n (sslength s)) 
      (while (> n 0) 
        (setq e (entget (ssname s (setq n (1- n)))) 
             p1 (cdr (assoc 10 e)) p2 (cdr (assoc 11 e)) 
              x (inters p1 p2 b1 b2 nil) 
        ) 
        (if x (progn 
                (setq d1 (distance x p1) d2 (distance x p2)) 
                (if (> d2 d1) 
                    (entmod (subst (cons 10 x) (assoc 10 e) e)) 
                    (entmod (subst (cons 11 x) (assoc 11 e) e)) 
      ) )     ) ) 
      (redraw b) 
      (setq b (car (entsel "\nSelect baundary edge .....")) s nil) 
    ) 
;; (setvar 'OsMode 167) 
)

soly2006 · 发表于 2013-7-25 17:13

Andyhon 发表于 2013-7-24 12:32
Ref:

大师有针对多段线的吗？能判断线两端自动延伸或缩短到最近的线上的，不需要选择？

Andyhon · 发表于 2013-7-25 17:50

若非单是线(Line) 不曾写过...
以您实务上约三例(*.Dwg)上传
若不甚费事可考虑练练手...

soly2006 · 发表于 2013-7-29 15:31

Andyhon 发表于 2013-7-25 17:50
若非单是线(Line) 不曾写过...
以您实务上约三例(*.Dwg)上传
若不甚费事可考虑练练手...

测量上用的，看能否帮助解决，谢谢。

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

[提问] 多段线自动伸缩，有谁帮忙解决一下好吗？

本帖子中包含更多资源

本帖子中包含更多资源

点评

本帖子中包含更多资源