[LISP程序]：请问 线的双向偏移 程序怎么编啊？？

Jason1010

请问 线的双向偏移 程序怎么编啊？？  能否告诉小弟

taner

你搜一下，论坛里一大把！

120120

我也正需要这个!

zml84

要编制程序，得先将过程想清楚。在偏移时，关键是要确定偏移方向。
对于简单图形，比如圆和直线，其方向较好确定。

gysjy

最初由 Jason1010 发布
[B]请问 线的双向偏移 程序怎么编啊？？   [/B]

请参阅：线的双向偏移

秋枫

使用ActiveX接口。偏移值一个给正，一个给负。

2. 
   
3. 
   
4. ;; Arc, Circle, Ellipse, Line, LightweightPolyline, Polyline, Spline, XLine
   
5. (vl-load-com)
   
6. 
   
7. (defun C:offset2 (/ ent dist)
   
8.   (setq
   
9.     dist (getdist
   
10.            (strcat "双向偏移的距离：<" (rtos (getvar "OFFSETDIST")) ">")
    
11.          )
    
12.   )
    
13.   (if (null dist)
    
14.     (setq dist (getvar "offsetdist"))
    
15.     (setvar "offsetdist" dist)
    
16.   )
    
17.   (setq        ent
    
18.          (i:entselF
    
19.            "\n选择要双向偏移的对象："
    
20.            '((0
    
21.               .
    
22.               "ARC,ELLIPSE,CIRCLE,LINE,POLYLINE,LWPOLYLINE,XLINE,SPLINE"
    
23.              )
    
24.             )
    
25.          )
    
26.   )
    
27.   (princ ent)
    
28.   (if ent
    
29.     (progn
    
30.       (setq ent (car ent))
    
31.       (setq ent (vlax-ename->vla-object ent))
    
32.       (vla-offset ent dist)
    
33.       (vla-offset ent (- 0 dist))
    
34.     )
    
35.   )
    
36.   (princ)
    
37. )
    
38. 
    
39. (defun I:EntSelF
    
40.                  (Msg                        ; selection prompt
    
41.                   Filter                ; filter list
    
42.                   / EntN                ; (entsel) list, or "Exit" string
    
43.                   pbDist                ; pickbox size in drawing units
    
44.                   PtPick                ; point of selection from (entsel)
    
45.                   ssPick                ; selection set
    
46. ) ;_ closes variable declare
    
47.   (while (not EntN)                        ; while no selection (or no exit)
    
48.     (setq
    
49.       EntN (if Msg                        ; if selection prompt
    
50.              (entsel Msg)                ; then (entsel) w/prompt
    
51. 
    
52.              (entsel)                        ; else plain (entsel)
    
53.            ) ;_ closes if
    
54.     ) ;_ closes setq
    
55.     (if        (= (getvar "ErrNo") 52)                ; if null response
    
56.       (setq EntN "Exit")                ; then set flag to exit
    
57.     ) ;_ closes if
    
58.   ) ;_ closes while
    
59.   (cond
    
60.     ((/= EntN "Exit")                        ; if not exit
    
61.      (setq
    
62.        pbDist (abs                        ; return absolute number
    
63.                 (/
    
64.                   (*
    
65.                     (/                        ; get pixel ratio
    
66.                       (getvar "PickBox")
    
67.                       (cadr (getvar "ScreenSize"))
    
68.                     )
    
69.                     (getvar "ViewSize")        ; apply to viewsize
    
70.                   ) ;_ closes *
    
71.                   (sin (* 0.25 pi))        ; at 45?
    
72.                 ) ;_ closes /
    
73.               ) ;_ closes abs
    
74.        PtPick (cadr EntN)                ; get point of pick
    
75.      ) ;_ closes setq
    
76.      (if (setq ssPick (ssget "_C"        ; if entities in crossing
    
77.                              (polar PtPick (* 1.25 pi) pbDist)
    
78.                              (polar PtPick (* 0.25 pi) pbDist)
    
79.                              Filter        ; match filter, if any
    
80.                       ) ;_ closes ssget
    
81.          ) ;_ closes setq
    
82.        (cons                                ; then return first entity as (entsel)
    
83.          (ssname ssPick 0)
    
84.          (list PtPick)
    
85.        ) ;_ closes cons
    
86.      ) ;_ closes if
    
87.     ) ;_ closes condition
    
88.   ) ;_ closes cond
    
89. ) ;_ closes defun I:EntSelF
    
90. 
    
91. (princ)

<br /> <br /> ;; Arc, Circle, Ellipse, Line, LightweightPolyline, Polyline, Spline, XLine<br /> (vl-load-com)<br /> <br /> (defun C:offset2 (/ ent dist)<br />   (setq<br />     dist (getdist<br />            (strcat "双向偏移的距离：<" (rtos (getvar "OFFSETDIST")) ">")<br />          )<br />   )<br />   (if (null dist)<br />     (setq dist (getvar "offsetdist"))<br />     (setvar "offsetdist" dist)<br />   )<br />   (setq        ent<br />          (i:entselF<br />            "\n选择要双向偏移的对象："<br />            '((0<br />               .<br />               "ARC,ELLIPSE,CIRCLE,LINE,POLYLINE,LWPOLYLINE,XLINE,SPLINE"<br />              )<br />             )<br />          )<br />   )<br />   (princ ent)<br />   (if ent<br />     (progn<br />       (setq ent (car ent))<br />       (setq ent (vlax-ename->vla-object ent))<br />       (vla-offset ent dist)<br />       (vla-offset ent (- 0 dist))<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> (defun I:EntSelF<br />                  (Msg                        ; selection prompt<br />                   Filter                ; filter list<br />                   / EntN                ; (entsel) list, or "Exit" string<br />                   pbDist                ; pickbox size in drawing units<br />                   PtPick                ; point of selection from (entsel)<br />                   ssPick                ; selection set<br /> ) ;_ closes variable declare<br />   (while (not EntN)                        ; while no selection (or no exit)<br />     (setq<br />       EntN (if Msg                        ; if selection prompt<br />              (entsel Msg)                ; then (entsel) w/prompt<br /> <br />              (entsel)                        ; else plain (entsel)<br />            ) ;_ closes if<br />     ) ;_ closes setq<br />     (if        (= (getvar "ErrNo") 52)                ; if null response<br />       (setq EntN "Exit")                ; then set flag to exit<br />     ) ;_ closes if<br />   ) ;_ closes while<br />   (cond<br />     ((/= EntN "Exit")                        ; if not exit<br />      (setq<br />        pbDist (abs                        ; return absolute number<br />                 (/<br />                   (*<br />                     (/                        ; get pixel ratio<br />                       (getvar "PickBox")<br />                       (cadr (getvar "ScreenSize"))<br />                     )<br />                     (getvar "ViewSize")        ; apply to viewsize<br />                   ) ;_ closes *<br />                   (sin (* 0.25 pi))        ; at 45?<br />                 ) ;_ closes /<br />               ) ;_ closes abs<br />        PtPick (cadr EntN)                ; get point of pick<br />      ) ;_ closes setq<br />      (if (setq ssPick (ssget "_C"        ; if entities in crossing<br />                              (polar PtPick (* 1.25 pi) pbDist)<br />                              (polar PtPick (* 0.25 pi) pbDist)<br />                              Filter        ; match filter, if any<br />                       ) ;_ closes ssget<br />          ) ;_ closes setq<br />        (cons                                ; then return first entity as (entsel)<br />          (ssname ssPick 0)<br />          (list PtPick)<br />        ) ;_ closes cons<br />      ) ;_ closes if<br />     ) ;_ closes condition<br />   ) ;_ closes cond<br /> ) ;_ closes defun I:EntSelF<br /> <br /> (princ)

[/FONT]

Jason1010

谢谢大家。我知道了。