多段线偏移，弧曲率不变，弧长为offset下的长度

自贡黄明儒

多段线偏移，弧曲率不变，弧长为offset下的长度
请各位高手帮帮忙

edata

熬了两个晚上，终于像样了。
写在前面的话，对于保证半径不改变，如果用计算方式出的结果总是不满意，所以还是改成了command函数，最近在研究entmake偏移线，正好要算圆弧，所以才加班加点的改写代码，想早日弄出来。
注意，这样的偏移线是建立在偏移后新圆弧的两点不大于原来直径的情况下，才能得到结果，否则无效。

2. 
   
3. 
   
4. (defun c:tt(/ ent lst arclst en arclst i sk_pt ds newent bulgelst arcc )
   
5.   (if
   
6.   (and (setq en(if (setq ss(ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))(ssname ss 0)))
   
7.        (if en (progn (redraw en 3) t))
   
8.        (setq ds(getdist "\n指定偏移数值:"))
   
9.        (setq sk_pt(getpoint"\n指定偏移方向")))
   
10.   (progn
    
11.   
    
12.   (setq ent(entget en))  
    
13.   (setq lst '())
    
14.   (while (car ent)
    
15.     (if  (member (car(car ent)) '(10 40 41 42))
    
16.       (setq lst (cons (car ent)lst))
    
17.       )
    
18.     (setq ent(cdr ent))
    
19.     )
    
20.   (setq lst (reverse lst))  
    
21.   (setq i 0 arclst '())
    
22.   (while (car lst)
    
23.     (if (and (= (car (car lst)) 42)(/=(zerop (cdr (car lst))) t))
    
24.       (setq arclst(cons (list i (cdr (car lst))) arclst))
    
25.     )
    
26.     (if (= (car (car lst)) 10)(setq i(1+ i)))
    
27.     (setq lst(cdr lst))
    
28.     )
    
29.   (setq arclst (reverse arclst))  
    
30.   (setvar "cmdecho" 0)
    
31.   (command "offset" ds en sk_pt "")
    
32.   (while (and (car arclst)(sk_indexpt1 (entget en) (1+ (car(car arclst)))))
    
33.   (setq newent(entget(entlast)))
    
34.    
    
35.   (setq bulgelst (sk_bulge2arc  (sk_indexpt1 (entget en) (car(car arclst)))(sk_indexpt1 (entget en) (1+ (car(car arclst)))) (cadr(car arclst))))
    
36.     (setq newds(distance  (sk_indexpt1 (entget en) (car(car arclst))) (sk_indexpt1 (entget en) (1+ (car(car arclst))))))
    
37.     (if (<  newds (* (last bulgelst) 2))
    
38.       (progn
    
39.     (command "_.arc" "non"(sk_indexpt1 newent (car(car arclst)))"e""non"(sk_indexpt1 newent (1+ (car(car arclst)))) "r" (last bulgelst))   
    
40.   (setq arcc(entget(entlast)))
    
41.   (entdel(entlast))
    
42.   (setq bulges(sk_arc2bulge (cdr (assoc 10 arcc))
    
43.                             (cdr (assoc 50 arcc))
    
44.                             (cdr (assoc 51 arcc))
    
45.                             (cdr (assoc 40 arcc))))
    
46.   (if (< (cadr(car arclst)) 0)   
    
47.   (entmod (sk_newent newent (car(car arclst)) (* -1 (cadr bulges))))
    
48.     (entmod (sk_newent newent (car(car arclst)) (cadr bulges)))
    
49.   )))
    
50.     (setq arclst(cdr arclst ))
    
51.   )
    
52.   (setvar "cmdecho" 1)
    
53.   )
    
54.   (princ "\n没有选择对象.")
    
55.   )
    
56.   (princ)
    
57.   )
    
58. 
    
59.   ; 按点表顺序更新多段线顶点,无须更换的顶点用nil代替。by:langjs
    
60.   ; 例：(entmod (reent (entget (car (entsel "\n选多段线:"))) '(nil (0.0 0.0) (100.0 100.0))))更新多段线第二第三点。
    
61.   (defun sk_newent (ent index new43  / i nent x)
    
62.     (setq i 0  nent '())
    
63.     (foreach x ent
    
64.       (setq nent (if (and (= (car x) 42) (= (setq i (1+ i)) index ))
    
65.        (append  nent (list (cons 42 new43)))
    
66.        (append  nent (list x))
    
67.                  )
    
68.       )
    
69.     )
    
70.    
    
71.   )
    
72. (defun sk_indexpt1(ent ptindex / i pt)
    
73.   (setq i 1)
    
74.   (while (car ent)
    
75.     (if (and (= (car(car ent)) 10) )
    
76.       (progn
    
77.   (if (= i ptindex)
    
78.       (setq pt (cdr(car ent))))
    
79.       (setq i (1+ i))
    
80.       ))
    
81.     (setq ent (cdr ent))
    
82.     )
    
83.   pt
    
84.   )
    
85. 
    
86. 
    
87. (defun sk_arc2bulge ( c a1 a2 r )
    
88.     (list
    
89.         (polar c a1 r)
    
90.         (   (lambda ( a ) (/ (sin a) (cos a)))
    
91.             (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)
    
92.         )
    
93.         (polar c a2 r)
    
94.     )
    
95. )
    
96. 
    
97. (defun sk_bulge2arc ( p1 p2 b / a c r )
    
98.     (setq a (* 2 (atan b))
    
99.           r (/ (distance p1 p2) 2 (sin a))
    
100.           c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)
     
101.     )
     
102.     (if (minusp b)
     
103.         (list c (angle c p2) (angle c p1) (abs r))
     
104.         (list c (angle c p1) (angle c p2) (abs r))
     
105.     )
     
106. )
     

<br /> <br /> (defun c:tt(/ ent lst arclst en arclst i sk_pt ds newent bulgelst arcc )<br />   (if <br />   (and (setq en(if (setq ss(ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))(ssname ss 0)))<br />        (if en (progn (redraw en 3) t))<br />        (setq ds(getdist "\n指定偏移数值:"))<br />        (setq sk_pt(getpoint"\n指定偏移方向")))<br />   (progn<br />   <br />   (setq ent(entget en))  <br />   (setq lst '())<br />   (while (car ent)<br />     (if  (member (car(car ent)) '(10 40 41 42))<br />       (setq lst (cons (car ent)lst))<br />       )<br />     (setq ent(cdr ent))<br />     )<br />   (setq lst (reverse lst))  <br />   (setq i 0 arclst '())<br />   (while (car lst)<br />     (if (and (= (car (car lst)) 42)(/=(zerop (cdr (car lst))) t))<br />       (setq arclst(cons (list i (cdr (car lst))) arclst))<br />     )<br />     (if (= (car (car lst)) 10)(setq i(1+ i)))<br />     (setq lst(cdr lst))<br />     )<br />   (setq arclst (reverse arclst))  <br />   (setvar "cmdecho" 0)<br />   (command "offset" ds en sk_pt "")<br />   (while (and (car arclst)(sk_indexpt1 (entget en) (1+ (car(car arclst)))))<br />   (setq newent(entget(entlast)))<br />     <br />   (setq bulgelst (sk_bulge2arc  (sk_indexpt1 (entget en) (car(car arclst)))(sk_indexpt1 (entget en) (1+ (car(car arclst)))) (cadr(car arclst))))<br />     (setq newds(distance  (sk_indexpt1 (entget en) (car(car arclst))) (sk_indexpt1 (entget en) (1+ (car(car arclst))))))<br />     (if (<  newds (* (last bulgelst) 2))<br />       (progn<br />     (command "_.arc" "non"(sk_indexpt1 newent (car(car arclst)))"e""non"(sk_indexpt1 newent (1+ (car(car arclst)))) "r" (last bulgelst))    <br />   (setq arcc(entget(entlast)))<br />   (entdel(entlast))<br />   (setq bulges(sk_arc2bulge (cdr (assoc 10 arcc))<br />                             (cdr (assoc 50 arcc))<br />                             (cdr (assoc 51 arcc))<br />                             (cdr (assoc 40 arcc))))<br />   (if (< (cadr(car arclst)) 0)    <br />   (entmod (sk_newent newent (car(car arclst)) (* -1 (cadr bulges))))<br />     (entmod (sk_newent newent (car(car arclst)) (cadr bulges)))<br />   )))<br />     (setq arclst(cdr arclst ))<br />   )<br />   (setvar "cmdecho" 1)<br />   )<br />   (princ "\n没有选择对象.")<br />   )<br />   (princ)<br />   )<br /> <br />   ; 按点表顺序更新多段线顶点,无须更换的顶点用nil代替。by:langjs<br />   ; 例：(entmod (reent (entget (car (entsel "\n选多段线:"))) '(nil (0.0 0.0) (100.0 100.0))))更新多段线第二第三点。<br />   (defun sk_newent (ent index new43  / i nent x) <br />     (setq i 0  nent '())<br />     (foreach x ent<br />       (setq nent (if (and (= (car x) 42) (= (setq i (1+ i)) index ))<br />        (append  nent (list (cons 42 new43)))<br />        (append  nent (list x))<br />                  )<br />       )<br />     )<br />     <br />   )<br /> (defun sk_indexpt1(ent ptindex / i pt)<br />   (setq i 1)<br />   (while (car ent)<br />     (if (and (= (car(car ent)) 10) )<br />       (progn<br />   (if (= i ptindex)<br />       (setq pt (cdr(car ent))))<br />       (setq i (1+ i))<br />       ))<br />     (setq ent (cdr ent))<br />     )<br />   pt<br />   )<br /> <br /> <br /> (defun sk_arc2bulge ( c a1 a2 r )<br />     (list<br />         (polar c a1 r)<br />         (   (lambda ( a ) (/ (sin a) (cos a)))<br />             (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0)<br />         )<br />         (polar c a2 r)<br />     )<br /> )<br /> <br /> (defun sk_bulge2arc ( p1 p2 b / a c r )<br />     (setq a (* 2 (atan b))<br />           r (/ (distance p1 p2) 2 (sin a))<br />           c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)<br />     )<br />     (if (minusp b)<br />         (list c (angle c p2) (angle c p1) (abs r))<br />         (list c (angle c p1) (angle c p2) (abs r))<br />     )<br /> )<br />

q3_2006

能看下楼主最终的图啥样吗？？

自贡黄明儒

q3_2006 发表于 2013-10-26 14:29
能看下楼主最终的图啥样吗？？

如图片所见，就是弧的半径不变，但长度是要变化的。弧长是正常offset下的长度

q3_2006

自贡黄明儒 发表于 2013-10-26 14:31
如图片所见，就是弧的半径不变，但长度是要变化的。弧长是正常offset下的长度

你说的曲率不变是不是等于复制？

q3_2006

没看DWG图，理解有误

nzl1116

q3_2006 发表于 2013-10-26 16:45
代码很糙，楼主是高手，看我的思路就行，自己完善，我是新手，全当好玩了！

楼主的问题，还有一个条件没交代清楚，即然是多段线，那圆弧有可能是多段线的第一段，也有可能是中间段，当然了，也有可能是最后一段，如此的话，问题就出来了，按逆时针方向，不知道楼主要求的，是以圆弧的起点为标准还是以圆弧的终点为标准？

自贡黄明儒

nzl1116 发表于 2013-10-26 18:35
楼主的问题，还有一个条件没交代清楚，即然是多段线，那圆弧有可能是多段线的第一段，也有可能是中间段， ...

不管哪里为起点，均可。最好与offset的起点一样

edata

有趣的方案，和我最近思路有些相关，等有弄出来了在来。。

nzl1116

2. (defun c:tt (/ Pline Pldata mData Pnt0 Pnt1 Ang Ang0 Ang1 Dist D nData Bulge Bulge1 r0 r1 L cen)
   
3.   (vl-load-com)
   
4.   (if (setq Pline (car (entsel "\n选择多段线：")))
   
5.     (progn
   
6.       (setq Pldata (entget Pline))
   
7.       (if (member (cdr (assoc 0 Pldata)) '("LWPOLYLINE" "POLYLINE"))
   
8.         (progn
   
9.           (setq mData (vl-remove-if-not (function (lambda (x) (member (car x) '(10 42)))) Pldata))
   
10.           (if (setq Pnt0 (getpoint "\n指定偏移方向"))
    
11.             (progn
    
12.               (setq Pnt1 (vlax-curve-getClosestPointTo Pline Pnt0)
    
13.                     Ang  (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv Pline (vlax-curve-getParamAtPoint Pline Pnt1)))
    
14.                     Ang  (- (angle Pnt1 Pnt0) Ang)
    
15.               )
    
16.               (if (setq Dist (getreal "\n指定偏移距离"))
    
17.                 (progn
    
18.                   (setq Pnt0  (cdar mData)
    
19.                         Ang0  (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv Pline (vlax-curve-getParamAtPoint Pline Pnt0)))
    
20.                         Pnt1  (polar Pnt0 (+ Ang0 Ang) Dist)
    
21.                         nData (list (cons 10 Pnt1))
    
22.                   )
    
23.                   (while mData
    
24.                     (setq Pnt2 (cdar mData)
    
25.                           Pnt3 (cdaddr mData)
    
26.                           D    (distance Pnt2 Pnt3)
    
27.                     )
    
28.                     (if (= (setq Bulge (cdadr mData)) 0)
    
29.                       (progn
    
30.                         (setq nData (cons '(42 . 0) nData)
    
31.                               Pnt1  (polar Pnt1 Ang0 D)
    
32.                               nData (cons (cons 10 Pnt1) nData)
    
33.                         )
    
34.                       )
    
35.                       (progn
    
36.                         (setq Ang1 (* (atan Bulge) 4)
    
37.                               r0   (abs (/ D 2 (sin (/ Ang1 2))))
    
38.                         )
    
39.                         (if (> (* Ang1 Ang) 0)
    
40.                           (setq r1 (- r0 Dist))
    
41.                           (setq r1 (+ r0 Dist))
    
42.                         )
    
43.                         (if (> Bulge 0)
    
44.                           (setq Ang1 (+ Ang0 (* pi 0.5)))
    
45.                           (setq Ang1 (- Ang0 (* pi 0.5)))
    
46.                         )
    
47.                         (setq cen (polar Pnt1 Ang1 r0))
    
48.                         (setq L     (* (abs Ang1) r1)
    
49.                               Ang1  (/ L r0)
    
50.                         )
    
51.                         (if (> Bulge 0)
    
52.                           (setq Pnt1 (polar cen (+ (angle cen Pnt1) Ang1) r0)
    
53.                                 Ang0 (- (angle cen Pnt1) (* pi 0.5))
    
54.                           )
    
55.                           (setq Pnt1 (polar cen (- (angle cen Pnt1) Ang1) r0)
    
56.                                 Ang0 (+ (angle cen Pnt1) (* pi 0.5))
    
57.                           )
    
58.                         )
    
59.                         (setq Ang1   (/ Ang1 4)
    
60.                               Bulge1 (/ (sin Ang1) (cos Ang1))
    
61.                         )
    
62.                         (if (< Bulge 0)
    
63.                           (setq Bulge1 (* Bulge1 -1))
    
64.                         )
    
65.                         (setq nData (cons (cons 42 Bulge1) nData)
    
66.                               nData (cons (cons 10 Pnt1) nData)
    
67.                         )
    
68.                       )
    
69.                     )
    
70.                     (setq mData (cddr mData))
    
71.                   )
    
72.                   (setq nData (reverse nData))
    
73.                   (entmakex
    
74.                     (append
    
75.                       (vl-remove-if
    
76.                         (function (lambda (x)
    
77.                                     (member (car x) '(10 40 41 42 90))
    
78.                                   )
    
79.                         )
    
80.                         Pldata
    
81.                       )
    
82.                       nData
    
83.                       (list (cons 90 (/ (1+ (length nData)) 2)))
    
84.                     )
    
85.                   )
    
86.                 )
    
87.               )
    
88.             )
    
89.           )
    
90.         )
    
91.         (princ "\n选择的图元不是多段线")
    
92.       )
    
93.     )
    
94.     (princ "\n没有选择图元")
    
95.   )
    
96.   (princ)
    
97. )

(defun c:tt (/ Pline Pldata mData Pnt0 Pnt1 Ang Ang0 Ang1 Dist D nData Bulge Bulge1 r0 r1 L cen)<br />   (vl-load-com)<br />   (if (setq Pline (car (entsel "\n选择多段线：")))<br />     (progn<br />       (setq Pldata (entget Pline))<br />       (if (member (cdr (assoc 0 Pldata)) '("LWPOLYLINE" "POLYLINE"))<br />         (progn<br />           (setq mData (vl-remove-if-not (function (lambda (x) (member (car x) '(10 42)))) Pldata))<br />           (if (setq Pnt0 (getpoint "\n指定偏移方向"))<br />             (progn<br />               (setq Pnt1 (vlax-curve-getClosestPointTo Pline Pnt0)<br />                     Ang  (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv Pline (vlax-curve-getParamAtPoint Pline Pnt1)))<br />                     Ang  (- (angle Pnt1 Pnt0) Ang)<br />               )<br />               (if (setq Dist (getreal "\n指定偏移距离"))<br />                 (progn<br />                   (setq Pnt0  (cdar mData)<br />                         Ang0  (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv Pline (vlax-curve-getParamAtPoint Pline Pnt0)))<br />                         Pnt1  (polar Pnt0 (+ Ang0 Ang) Dist)<br />                         nData (list (cons 10 Pnt1))<br />                   )<br />                   (while mData<br />                     (setq Pnt2 (cdar mData)<br />                           Pnt3 (cdaddr mData)<br />                           D    (distance Pnt2 Pnt3)<br />                     )<br />                     (if (= (setq Bulge (cdadr mData)) 0)<br />                       (progn<br />                         (setq nData (cons '(42 . 0) nData)<br />                               Pnt1  (polar Pnt1 Ang0 D)<br />                               nData (cons (cons 10 Pnt1) nData)<br />                         )<br />                       )<br />                       (progn<br />                         (setq Ang1 (* (atan Bulge) 4)<br />                               r0   (abs (/ D 2 (sin (/ Ang1 2))))<br />                         )<br />                         (if (> (* Ang1 Ang) 0)<br />                           (setq r1 (- r0 Dist))<br />                           (setq r1 (+ r0 Dist))<br />                         )<br />                         (if (> Bulge 0)<br />                           (setq Ang1 (+ Ang0 (* pi 0.5)))<br />                           (setq Ang1 (- Ang0 (* pi 0.5)))<br />                         )<br />                         (setq cen (polar Pnt1 Ang1 r0))<br />                         (setq L     (* (abs Ang1) r1)<br />                               Ang1  (/ L r0)<br />                         )<br />                         (if (> Bulge 0)<br />                           (setq Pnt1 (polar cen (+ (angle cen Pnt1) Ang1) r0)<br />                                 Ang0 (- (angle cen Pnt1) (* pi 0.5))<br />                           )<br />                           (setq Pnt1 (polar cen (- (angle cen Pnt1) Ang1) r0)<br />                                 Ang0 (+ (angle cen Pnt1) (* pi 0.5))<br />                           )<br />                         )<br />                         (setq Ang1   (/ Ang1 4)<br />                               Bulge1 (/ (sin Ang1) (cos Ang1))<br />                         )<br />                         (if (< Bulge 0)<br />                           (setq Bulge1 (* Bulge1 -1))<br />                         )<br />                         (setq nData (cons (cons 42 Bulge1) nData)<br />                               nData (cons (cons 10 Pnt1) nData)<br />                         )<br />                       )<br />                     )<br />                     (setq mData (cddr mData))<br />                   )<br />                   (setq nData (reverse nData))<br />                   (entmakex<br />                     (append<br />                       (vl-remove-if<br />                         (function (lambda (x)<br />                                     (member (car x) '(10 40 41 42 90))<br />                                   )<br />                         )<br />                         Pldata<br />                       )<br />                       nData<br />                       (list (cons 90 (/ (1+ (length nData)) 2)))<br />                     )<br />                   )<br />                 )<br />               )<br />             )<br />           )<br />         )<br />         (princ "\n选择的图元不是多段线")<br />       )<br />     )<br />     (princ "\n没有选择图元")<br />   )<br />   (princ)<br /> )

夜深了，没时间调试了，先发码