多段线只偏移圆弧 修改

ga619091

liuhe 发表于 2022-8-31 13:29
你会lisp编程么？我可以提供给你思路，自己写。先创立一个选择集，识别图元或者句柄，分解掉选择集。再次 ...

我不会编译，只会大概了解某段的编译意思，在大佬们分享的LISP上自己加加减减贴上变成自己想要的功能
有参考板上文章的撷取某段做偏移，不过思路有点困难

llsheng_73

ga619091 发表于 2022-8-31 11:24
可能误会我意思
原始代码 多段线或者炸开的线段都能做偏移
但把LINE拿掉 就可以炸开只选择圆弧做 ...

选择包含凸度的多段线，
不严谨的做法：遍历多段线的点p，如果它的凸度值不为0，取它的下一点及中间点，这样就有弧段起止点及中点，根据3点共圆计算圆心，
根据圆心和起止点的角度及半径加上偏移距离计算偏移后的新的起止点，用取得的凸度值画一个弧段

1. (defun 3pcen(p1 p2 p3)
   
2.   (setq p1(list(/(+(car p1)(car p2))2)(/(+(cadr p1)(cadr p2))2))
   
3.         p3(list(/(+(car p2)(car p3))2)(/(+(cadr p2)(cadr p3))2)))
   
4. (inters p1(polar p1(+(/ pi 2)(angle p1 p2))1)p3(polar p3(+(/ pi 2)(angle p3 p2))1)nil))
   
5. (defun tt(e / en n p p1 p0 r bugle i)
   
6.   (setq en(entget e'("*"))n(vlax-curve-getendparam e)e(vlax-ename->vla-object e)i -1)
   
7.   (while(<(setq i(1+ i))n)
   
8.       (or(VL-CATCH-ALL-ERROR-P(setq p(vlax-curve-getpointatparam e i)
   
9.                                     bugle(VL-CATCH-ALL-APPLY'vlax-invoke-method(List  e 'GetBulge i))))
   
10.          (and(/= bugle 0)
    
11.              (setq p1(vlax-curve-getpointatparam e(1+ i)))
    
12.              (setq p0(vlax-curve-getpointatparam e(+ i 0.5)))
    
13.              (setq p0(3pcen p p0 p1)r(+(distance p0 p)d))
    
14.              (entmakex(vl-remove'nil(append(mapcar'cons'(0 100 100 62 8 90 70 10 42 10)
    
15.                              (list"LWPOLYLINE""AcDbEntity""AcDbPolyline"1"bmcl"2 128(polar p0(angle p0 p)r)bugle(polar p0(angle p0 p1)r)))
    
16.                              (mapcar'(lambda(x)(assoc x en))'(6 8 62 370 38 -3)))))))))
    
17. 
    
18. (defun c:tt(/ s e d)
    
19.   (or(setq d(getdist"偏移距离[1.0]"))(setq d 1))
    
20.   (if(setq s(ssget '((0 . "lwpolyline")(-4 . "/=")(42 . 0))))
    
21.   (while(setq e(ssname s 0))
    
22.     (ssdel e s)
    
23.     (tt e)
    
24.     )))
    

(defun 3pcen(p1 p2 p3)<br />   (setq p1(list(/(+(car p1)(car p2))2)(/(+(cadr p1)(cadr p2))2))<br />         p3(list(/(+(car p2)(car p3))2)(/(+(cadr p2)(cadr p3))2)))<br /> (inters p1(polar p1(+(/ pi 2)(angle p1 p2))1)p3(polar p3(+(/ pi 2)(angle p3 p2))1)nil))<br /> (defun tt(e / en n p p1 p0 r bugle i)<br />   (setq en(entget e'("*"))n(vlax-curve-getendparam e)e(vlax-ename->vla-object e)i -1)<br />   (while(<(setq i(1+ i))n)<br />       (or(VL-CATCH-ALL-ERROR-P(setq p(vlax-curve-getpointatparam e i)<br />                                     bugle(VL-CATCH-ALL-APPLY'vlax-invoke-method(List  e 'GetBulge i))))<br />          (and(/= bugle 0)<br />              (setq p1(vlax-curve-getpointatparam e(1+ i)))<br />              (setq p0(vlax-curve-getpointatparam e(+ i 0.5)))<br />              (setq p0(3pcen p p0 p1)r(+(distance p0 p)d))<br />              (entmakex(vl-remove'nil(append(mapcar'cons'(0 100 100 62 8 90 70 10 42 10)<br />                              (list"LWPOLYLINE""AcDbEntity""AcDbPolyline"1"bmcl"2 128(polar p0(angle p0 p)r)bugle(polar p0(angle p0 p1)r)))<br />                              (mapcar'(lambda(x)(assoc x en))'(6 8 62 370 38 -3)))))))))<br /> <br /> (defun c:tt(/ s e d)<br />   (or(setq d(getdist"偏移距离[1.0]"))(setq d 1))<br />   (if(setq s(ssget '((0 . "lwpolyline")(-4 . "/=")(42 . 0))))<br />   (while(setq e(ssname s 0))<br />     (ssdel e s)<br />     (tt e)<br />     )))<br />

更严格的做法应该是：根据偏移距离先偏移整条多段线，再找出其中的弧段来重新绘制，删除偏移后的线

ga619091

llsheng_73 发表于 2022-8-31 17:07

73大 厉害了 这就是我想要的效果，我自己在研究怎么用框选处理多图形

llsheng_73

ga619091 发表于 2022-8-31 17:24
73大 厉害了 这就是我想要的效果，我自己在研究怎么用框选处理多图形

把(ssget":E:S"'((0 . "lwpolyline")(-4 . "/=")(42 . 0)))改成其它选择方式，不用点选方式

ga619091

llsheng_73 发表于 2022-8-31 17:25
把(ssget":E:S"'((0 . "lwpolyline")(-4 . "/=")(42 . 0)))改成其它选择方式，不用点选方式

好的 谢谢

Juno

先炸开，完成功能后，再把他们合并起来，这样从画图角度，是不是相当于没炸开？

ga619091

Juno 发表于 2022-8-31 21:42
先炸开，完成功能后，再把他们合并起来，这样从画图角度，是不是相当于没炸开？

主要是想省炸开才能偏移圆弧这个步骤，但写程式上来说是需要炸开提出圆弧 原图再进行合并

ga619091

顺便附上73大的 改框选版本

ga619091

可以了

llsheng_73

ga619091 发表于 2022-9-1 17:19
73大 能帮我看一下代码问题
我在你的代码基础上改成匡选加偏移的弧形红色显示
匡选可以 但是弧形偏移

原来(mapcar 'cons '(0 100 100 90 70 10 42 10)(list "LWPOLYLINE" "AcDbEntity" "AcDbPolyline" 2 128 (polar p0(angle p0 p)r) bugle (polar p0 (angle p0 p1)r))
加一个62组和8组就可以控制颜色和图层了
(mapcar 'cons '(0 100 100 62 90 70 10 42 10 )(list "LWPOLYLINE" "AcDbEntity" "AcDbPolyline"1 2 128 (polar p0(angle p0 p)r) bugle (polar p0 (angle p0 p1)r))


还是看12楼修改后的吧，你修改那个实在费看。。。