autolisp如何实现多段线中的圆弧部分用插密多段线来替换

275437962

CAD中实现所有图层多段线中的圆弧部分用插密多段线的方式来替换，即多段线中的圆弧部分用普通多段线加点插密的方式逼近， 并保证这些多段线处理后所在的图层与其原来所在的图层一致。
（说明：单独的圆弧对象不做处理）
( 说明： 整个多段线同宽 )

zijiren007

提问很好，求高手解答

菜卷鱼

你这么做的用意是什么？直接把圆弧转换成多段线不行？

275437962

菜卷鱼 发表于 2013-12-27 14:02
你这么做的用意是什么？直接把圆弧转换成多段线不行？

我的这个圆弧不是单独的圆弧对象，而用是多段线中的弧，它是作为多段线的一部分存在的！！！

masterlong

这个程序做起来并不是那么容易
如果整个PL线同宽还好点
如果不同宽就麻烦了

假设同宽
我的思路是这样的
记录宽度
和所有的节点坐标polist
炸碎PL线
获取前一选择集SS
遍历
遇到圆弧
记录起点终点
求弧长计算查密点个数
divide命令
记录新生成的点坐标
并加入到polist
最后删点删SS
画PL线

最近是相当的忙
有空的来试试吧

275437962

masterlong 发表于 2013-12-27 21:54
这个程序做起来并不是那么容易
如果整个PL线同宽还好点
如果不同宽就麻烦了

可以保证，每一条多段线都是同宽的，你好，还是帮个忙吧！！！

自贡黄明儒

masterlong 发表于 2013-12-27 21:54
这个程序做起来并不是那么容易
如果整个PL线同宽还好点
如果不同宽就麻烦了

不用这么复杂吧，我也正想写这个。等忙过这段时间写一个。

自贡黄明儒

啊，楼主修改了呀，饭也不请了，悬赏也不见了

1. ;;[通用函数] 带过滤器的entsel
   
2. (defun Fsxm-entsel (msg filter)
   
3.   (setq enp (entsel msg))
   
4.   (if (or (= (type enp) 'str)
   
5.     (and enp (ssget (cadr enp) filter))
   
6.       )
   
7.     enp
   
8.   )
   
9. )
   
10. ;;多段线弧用折线代替
    
11. (defun C:w2 ()
    
12.   ;;164.3 [功能] 多段线凸度列表
    
13.   ;;示例(get42 (entget(car (entsel))))
    
14.   (defun get42 (en)
    
15.     (mapcar 'cdr
    
16.       (vl-remove-if-not '(lambda (x) (= (car x) 42)) en)
    
17.     )
    
18.   )
    
19.   ;;沿多段线取点，弧处按角度加密取点
    
20.   (defun LP:getpts (E EN / I II J L42 N PT PTLST X)
    
21.     (setq l42 (get42 en))
    
22.     (setq j 0)
    
23.     (repeat (setq n (fix (vlax-curve-getEndParam e)))
    
24.       (setq x (car l42))
    
25.       (setq l42 (cdr l42))
    
26.       (cond ((equal x 0)
    
27.        (setq pt (vlax-curve-getPointAtParam e j))
    
28.        (setq ptlst (cons pt ptlst))
    
29.        (setq j (1+ j))
    
30.       )
    
31.       (T
    
32.        (setq i (fix (/ (* (atan (abs x)) 180) pi)))   ;弧取点密度
    
33.        (setq ii (/ 1.0 i))
    
34.        (repeat i         
    
35.          (setq pt (vlax-curve-getPointAtParam e j))
    
36.          (setq ptlst (cons pt ptlst))
    
37.          (setq j (+ ii j))
    
38.        )
    
39.        (setq j (fix (+ 0.5 j)))
    
40.       )
    
41.       )
    
42.     )
    
43.     ptlst
    
44.   )
    
45. 
    
46.   ;;164.31 [功能] 点表生成多段线
    
47.   (defun Make-LWPOLYLINE (lst / PT)
    
48.     (entmake (append (list '(0 . "LWPOLYLINE")
    
49.          '(100 . "AcDbEntity")
    
50.          '(100 . "AcDbPolyline")
    
51.          (cons 90 (length lst))
    
52.          )
    
53.          (mapcar '(lambda (pt) (cons 10 pt)) lst)
    
54.        )
    
55.     )
    
56.   )
    
57. 
    
58.   (setq e (Fsxm-entsel "\n 选择剖面的多段线" '((0 . "LWPOLYLINE"))))
    
59.   (setq pt (cadr e))
    
60.   (setq e (car e))
    
61.   (setq en (entget e))
    
62.   (Make-LWPOLYLINE (LP:getpts E EN))
    
63. )

;;[通用函数] 带过滤器的entsel<br /> (defun Fsxm-entsel (msg filter)<br />   (setq enp (entsel msg))<br />   (if (or (= (type enp) 'str)<br />     (and enp (ssget (cadr enp) filter))<br />       )<br />     enp<br />   )<br /> )<br /> ;;多段线弧用折线代替<br /> (defun C:w2 ()<br />   ;;164.3 [功能] 多段线凸度列表<br />   ;;示例(get42 (entget(car (entsel))))<br />   (defun get42 (en)<br />     (mapcar 'cdr<br />       (vl-remove-if-not '(lambda (x) (= (car x) 42)) en)<br />     )<br />   )<br />   ;;沿多段线取点，弧处按角度加密取点<br />   (defun LP:getpts (E EN / I II J L42 N PT PTLST X)<br />     (setq l42 (get42 en))<br />     (setq j 0)<br />     (repeat (setq n (fix (vlax-curve-getEndParam e)))<br />       (setq x (car l42))<br />       (setq l42 (cdr l42))<br />       (cond ((equal x 0)<br />        (setq pt (vlax-curve-getPointAtParam e j))<br />        (setq ptlst (cons pt ptlst))<br />        (setq j (1+ j))<br />       )<br />       (T<br />        (setq i (fix (/ (* (atan (abs x)) 180) pi)))   ;弧取点密度<br />        (setq ii (/ 1.0 i))<br />        (repeat i         <br />          (setq pt (vlax-curve-getPointAtParam e j))<br />          (setq ptlst (cons pt ptlst))<br />          (setq j (+ ii j))<br />        )<br />        (setq j (fix (+ 0.5 j)))<br />       )<br />       )<br />     )<br />     ptlst<br />   )<br /> <br />   ;;164.31 [功能] 点表生成多段线<br />   (defun Make-LWPOLYLINE (lst / PT)<br />     (entmake (append (list '(0 . "LWPOLYLINE")<br />          '(100 . "AcDbEntity")<br />          '(100 . "AcDbPolyline")<br />          (cons 90 (length lst))<br />          )<br />          (mapcar '(lambda (pt) (cons 10 pt)) lst)<br />        )<br />     )<br />   )<br /> <br />   (setq e (Fsxm-entsel "\n 选择剖面的多段线" '((0 . "LWPOLYLINE"))))<br />   (setq pt (cadr e))<br />   (setq e (car e))<br />   (setq en (entget e))<br />   (Make-LWPOLYLINE (LP:getpts E EN))<br /> )

275437962

自贡黄明儒 发表于 2013-12-31 16:48
啊，楼主修改了呀，饭也不请了，悬赏也不见了

朋友，有问题啊，一个是插密的间距不能人为设置，还有是原来的线没有删除，还有是，不能所有框选，自动对有有弧的多段线进行处理， 只能找到这条线，然后一条一条选 ，去处理！！！！不是太实用！！！

emk

楼主自己改改就好。。。。。。