[LISP程序]：请大家看看,里面的问题

前生 · 发表于 2003-5-7 18:04:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

问题如附件帖图.
求一lsp程序
点击PLIne 线A边一点,然后再点击一点定方向.使PLine线的A边向所定的方向比如1MM copy一个Pline的片段
谢谢

ll_j · 发表于 2003-5-7 18:29:25

如果是弧段想如何处理？

cy956 · 发表于 2003-5-7 18:45:24

前大哥，你是不是被 lwpline 给噎住了？：D
有线有方向，可以的。

XDSoft · 发表于 2003-5-7 20:35:17

最初由前生发布
[B]问题如附件帖图.
求一lsp程序
点击PLIne 线A边一点,然后再点击一点定方向.使PLine线的A边向所定的方向比如1MM copy一个Pline的片段
谢谢 [/B]

编程思路：

1、原地获得一个实体拷贝
2、得到包括指定点的POLY段的顶点前后索引表
3、删除实体拷贝除了这个段两个顶点的所有顶点，得到需要的段
4、移动得到的实体拷贝（可以移动，或者OFFSET）

演示和代码如下，可以处理POLYLINE，也可以处理LWPOLYLINE（程序在XDRX_API环境下使用）：

下载地址：http://www.xdcad.net/tech/xd_tbox/forum_polyoffset.swf

<embed src=http://www.xdcad.net/tech/xd_tbox/forum_polyoffset.swf quality=high width=512 height=482 loop=true type="application/x-shockwave-flash">
</embed>

<normalfont>
;|
根据LWPOLYLINE实体和输入点，返回包括该点的段的前后顶点索引表
索引从0开始
|;
(defun $XDLSP_Polyline_VertIndexOnSeg (e pt / num index tf)
(setq num (xdrx_polyline_numVerts e);;[color=blue]获得LWPOLYLINE实体的顶点数[/color]
index 0
tf t
)
(while (and
tf
(< index num)
)
(if (xdrx_polyline_onSegAt e index pt);;[color=blue]判断点是否在从索引INDEX开始的段上[/color]
(setq tf nil)
)
(setq index (1+ index))
)
(if (not tf)
(list (1- index) index)
)
)
(defun c:XDTB_PolyOffset (/ e pt dis pnt pnt1 mat tVec tMat vert num i index)
(if (and
(setq e (xdrx_entsel "\n拾取POLYLINE的要偏移后保留的段<退出>:" '
((0 . "*polyline"))
)
)
(setq pt (cadr e)
e (car e)
)
(progn
(redraw e 3)
t
)
(setq dis (getreal "\n输入平移距离<退出>:"))
(setq pnt (getpoint pt "\n拾取方向<退出>:"))
)
(progn
(setq cls (xdrx_object_classname e));;[color=blue]得到实体的类名，如 ("POLYLINE" "AcDb2dPolyline")[/color]
(if (= (car cls) "POLYLINE");;[color=blue]如果是老的多义线，转换成LWPOLYLINE[/color]
(progn
(xdrx_polyline_convertfrom e);;[color=blue]转换函数[/color]
(setq e (entlast)))
)
(setq mat (xdrx_matrix_identity 3));;[color=blue]构造单位矩阵[/color]
(xdrx_entity_transformedCopy e mat);;[color=blue]得到原样原位置的一个拷贝[/color]
(redraw e 4)
(setq e (entlast))
(setq vert ($XDLSP_Polyline_VertIndexOnSeg e pt));;[color=blue]获得包括输入点的POLY段的前后顶点索引值表[/color]
(setq num (xdrx_polyline_numVerts e));;[color=blue]得到多义线顶点数[/color]
(setq i 0
index 0
)
(repeat num ;;[color=blue]循环处理顶点[/color]
(if (not (member i vert));;[color=blue]如果当前顶点不在上面得到的顶点索引表，删除顶点[/color]
(progn
(xdrx_polyline_removeVertexAt e index);;[color=blue]删除LWPOLYLINE顶点索引为0的顶点[/color]
)
(progn
(setq index 2);;[color=blue]索引顶点设置2，删除所在段后面的所有顶点[/color]
)
)
(setq i (1+ i))
)
(setq pnt1 (xdrx_curve_getClosestPoint e pnt);;[color=blue]根据方向，得到在需要段内的最近点[/color]
tVec (mapcar '- pnt pnt1);;[color=blue]转换成向量(相对位移)[/color]
tVec (xdrx_vector_Normalize tVec);;[color=blue]转换成单位向量[/color]
tVec (mapcar '* tVec (list dis dis dis));;[color=blue]根据输入的距离DIS，得到平移向量[/color]
tMat (xdrx_matrix_setTranslation mat tVec);;[color=blue]构造平移转换矩阵[/color]
)
(xdrx_entity_transForm e tMat);;[color=blue]把矩阵作用到得到拷贝处理后的剩下段的LWPOLYLINE上，平移实体[/color]
)
)
(princ)
)
</normalfont>

<normalfont> 
;| 
   根据LWPOLYLINE实体和输入点，返回包括该点的段的前后顶点索引表 
   索引从0开始 
|; 
(defun $XDLSP_Polyline_VertIndexOnSeg (e pt / num index tf) 
  (setq num (xdrx_polyline_numVerts e);;[color=blue]获得LWPOLYLINE实体的顶点数[/color] 
        index 0 
        tf t 
  ) 
  (while (and 
           tf 
           (< index num) 
         ) 
    (if (xdrx_polyline_onSegAt e index pt);;[color=blue]判断点是否在从索引INDEX开始的段上[/color] 
      (setq tf nil) 
    ) 
    (setq index (1+ index)) 
  ) 
  (if (not tf) 
    (list (1- index) index) 
  ) 
) 
 
(defun c:XDTB_PolyOffset (/ e pt dis pnt pnt1 mat tVec tMat vert num i index) 
  (if (and 
        (setq e (xdrx_entsel "\n拾取POLYLINE的要偏移后保留的段<退出>:" ' 
                             ((0 . "*polyline")) 
                ) 
        ) 
        (setq pt (cadr e) 
              e (car e) 
        ) 
        (progn 
          (redraw e 3) 
          t 
        ) 
        (setq dis (getreal "\n输入平移距离<退出>:")) 
        (setq pnt (getpoint pt "\n拾取方向<退出>:")) 
      ) 
    (progn 
      (setq cls (xdrx_object_classname e));;[color=blue]得到实体的类名，如 ("POLYLINE" "AcDb2dPolyline")[/color] 
      (if (= (car cls) "POLYLINE");;[color=blue]如果是老的多义线，转换成LWPOLYLINE[/color] 
        (progn 
         (xdrx_polyline_convertfrom e);;[color=blue]转换函数[/color] 
         (setq e (entlast))) 
      ) 
      (setq mat (xdrx_matrix_identity 3));;[color=blue]构造单位矩阵[/color] 
      (xdrx_entity_transformedCopy e mat);;[color=blue]得到原样原位置的一个拷贝[/color] 
      (redraw e 4) 
      (setq e (entlast)) 
      (setq vert ($XDLSP_Polyline_VertIndexOnSeg e pt));;[color=blue]获得包括输入点的POLY段的前后顶点索引值表[/color] 
      (setq num (xdrx_polyline_numVerts e));;[color=blue]得到多义线顶点数[/color] 
      (setq i 0 
            index 0 
      ) 
      (repeat num  ;;[color=blue]循环处理顶点[/color] 
        (if (not (member i vert));;[color=blue]如果当前顶点不在上面得到的顶点索引表，删除顶点[/color] 
          (progn 
            (xdrx_polyline_removeVertexAt e index);;[color=blue]删除LWPOLYLINE顶点索引为0的顶点[/color] 
          ) 
          (progn 
            (setq index 2);;[color=blue]索引顶点设置2，删除所在段后面的所有顶点[/color] 
          ) 
        ) 
        (setq i (1+ i)) 
      ) 
      (setq pnt1 (xdrx_curve_getClosestPoint e pnt);;[color=blue]根据方向，得到在需要段内的最近点[/color] 
            tVec (mapcar '- pnt pnt1);;[color=blue]转换成向量(相对位移)[/color] 
            tVec (xdrx_vector_Normalize tVec);;[color=blue]转换成单位向量[/color] 
            tVec (mapcar '* tVec (list dis dis dis));;[color=blue]根据输入的距离DIS，得到平移向量[/color] 
            tMat (xdrx_matrix_setTranslation mat tVec);;[color=blue]构造平移转换矩阵[/color] 
      ) 
      (xdrx_entity_transForm e tMat);;[color=blue]把矩阵作用到得到拷贝处理后的剩下段的LWPOLYLINE上，平移实体[/color] 
    ) 
  ) 
  (princ) 
) 
</normalfont>

梦断江南 · 发表于 2003-5-7 21:03:38

记得以前xd写过一个规划用地范围各边不等距偏移的程序,和这个问题很相像,可以参考一下:)
除了以上xd程序中的方法,关于取得取点所在线段的探讨:
1.如果转换为lwpolyline旧版,点取位置用entsel应该能直接取得所在线段的数据,直接可以构造一个相对位移的线段copy
2.通过取点与pline线起始点的距离(l)判断所在位置.循环:>>从第一点开始,当节点到起始点的距离小于 l ,之前的数据可以略去,当大于l,之后的数据可以略去,就不必再继续判断了,这样就可以提取出所在线段的数据

mmmm · 发表于 2003-5-7 21:48:00

从我的工具集中摘出来的，使用Offset,对于直线，同拷贝结果一样
对于圆弧不同，但是根据需要可以修改程序

(defun c:mq (/ Obj ObjX Pt PtX Dist Rtn New Ortho CEcho Osmode)
(setq Osmode (getvar "Osmode")
Ortho (getvar "OrthoMode")
CEcho (getvar "CmdEcho")
)
(setvar "CmdEcho" 0)
(setvar "OrthoMode" 0)
(if (setq Obj (nentsel "\n Pick (Lw)Polyline segment <Exit>:"))
(setq Pt (cadr Obj)
Obj (car Obj)
)
)
(if (null (wcmatch (cdr (assoc 0 (entget Obj)))
"*POLYLINE"
)
)
(alert "\n not a polyline, please re-call function!")
(progn
(command "_.Undo" "_Group")
(command "_.Explode" Obj)
(setq ObjX (car (nentselp Pt))
Dist (getvar "OffsetDist")
)
(if (null
(setq
Dist (getdist
(strcat
"\n Enter offset distance [Minus for Through] <"
(rtos Dist 2 3)
">:"
)
)
)
)
(setq Dist (getvar "OffsetDist"))
)
(redraw ObjX 3)
(princ "\n Pick offset direction <exit>:")
(if (setq PtX (getpoint Pt))
(progn
(setvar "osmode" 0)
(command "_.Offset"
(if (> Dist 0.0)
Dist
"_T"
)
(list ObjX Pt)
PtX
)
(while (/= (getvar "CmdNames") "")
(command "")
)
(setq Rtn (cdr (entget (entlast))))
)
)
(command "_.Undo" "_End")
(command "_U")
(if Rtn
(entmake Rtn)
)
)
)
(if Osmode
(setvar "osmode" Osmode)
)
(if Ortho
(setvar "OrthoMode" Ortho)
)
(if CEcho
(setvar "CmdEcho" CEcho)
)
(princ)
)

(defun c:mq (/ Obj ObjX Pt PtX Dist Rtn New Ortho CEcho Osmode) 
  (setq        Osmode (getvar "Osmode") 
        Ortho  (getvar "OrthoMode") 
        CEcho  (getvar "CmdEcho") 
  ) 
  (setvar "CmdEcho" 0) 
  (setvar "OrthoMode" 0) 
  (if (setq Obj (nentsel "\n Pick (Lw)Polyline segment <Exit>:")) 
    (setq Pt  (cadr Obj) 
          Obj (car Obj) 
    ) 
  ) 
  (if (null (wcmatch (cdr (assoc 0 (entget Obj))) 
                     "*POLYLINE" 
            ) 
      ) 
    (alert "\n not a polyline, please re-call function!") 
    (progn 
      (command "_.Undo" "_Group") 
      (command "_.Explode" Obj) 
      (setq ObjX (car (nentselp Pt)) 
            Dist (getvar "OffsetDist") 
      ) 
      (if (null 
            (setq 
              Dist (getdist 
                     (strcat 
                       "\n Enter offset distance [Minus for Through] <" 
                       (rtos Dist 2 3) 
                       ">:" 
                     ) 
                   ) 
            ) 
          ) 
        (setq Dist (getvar "OffsetDist")) 
      ) 
      (redraw ObjX 3) 
      (princ "\n Pick offset direction <exit>:") 
      (if (setq PtX (getpoint Pt)) 
        (progn 
          (setvar "osmode" 0) 
          (command "_.Offset" 
                   (if (> Dist 0.0) 
                     Dist 
                     "_T" 
                   ) 
                   (list ObjX Pt) 
                   PtX 
          ) 
          (while (/= (getvar "CmdNames") "") 
            (command "") 
          ) 
          (setq Rtn (cdr (entget (entlast)))) 
        ) 
      ) 
      (command "_.Undo" "_End") 
      (command "_U") 
      (if Rtn 
        (entmake Rtn) 
      ) 
    ) 
  ) 
  (if Osmode 
    (setvar "osmode" Osmode) 
  ) 
  (if Ortho 
    (setvar "OrthoMode" Ortho) 
  ) 
  (if CEcho 
    (setvar "CmdEcho" CEcho) 
  ) 
  (princ) 
)

前生 · 发表于 2003-5-8 09:58:34

呵呵。高，就是这样子的!

LUCAS · 发表于 2003-5-8 10:27:16

;;前生兄等等!!还有这个!!
;;By LUCAS(龙龙仔)
(defun C:PLINEOFFSET (/ HOLDECHO HOLDOSMODE ENT ENT1 ENT2 DIST PNT)
(defun SEGMENTPTS (ENT / PNT VOBJ PARAM1 PARAM2 P1 P2 SEGPTS)
(and
(setq VOBJ (vlax-ename->vla-object (car ENT)))
(setq PNT (trans (cadr ENT) 1 0))
(setq PNT (vlax-curve-getclosestpointto VOBJ PNT))
(setq PARAM1 (vlax-curve-getparamatpoint VOBJ PNT))
(setq PARAM1 (fix PARAM1))
(setq PARAM2 (1+ PARAM1))
(if (equal PARAM1 (vlax-curve-getstartparam VOBJ) 1e-10)
(setq P1 (vlax-curve-getstartpoint VOBJ))
(setq P1 (vlax-curve-getpointatparam VOBJ PARAM1))
)
(if (equal PARAM2 (vlax-curve-getendparam VOBJ) 1e-10)
(setq P2 (vlax-curve-getendpoint VOBJ))
(setq P2 (vlax-curve-getpointatparam VOBJ PARAM2))
)
P1
P2
(setq BULGE (vla-getbulge VOBJ PARAM1))
(setq SEGPTS (list P1 P2 BULGE))
)
SEGPTS
)
(defun CALCBULGE (ENT / ARCRAD CENDIR HLFANG)
(setq VX1 (nth 0 ENT)
VX2 (nth 1 ENT)
BLG (nth 2 ENT)
)
(setq HLFANG (* 2 (atan BLG))
CENDIR ((if (< BLG 0)
-
+
)
(- (angle VX1 VX2) HLFANG)
(/ pi 2)
)
ARCRAD (abs (/ (/ (distance VX1 VX2) 2.0) (sin HLFANG)))
)
(list
(polar VX1 CENDIR ARCRAD)
ARCRAD
(* (abs HLFANG) 2.0)
)
)
(setq HOLDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "_group")
(setq HOLDOSMODE (getvar "osmode"))
(setvar "osmode" 0)
(while (null ENT)
(prompt "\n拾取POLYLINE要偏移的段: ")
(setq ENT (ssget ":S" '((0 . "*POLYLINE"))))
)
(setq ENT (list (ssname ENT 0)
(osnap (cadr (nth 3 (car (ssnamex ENT 0)))) "nea")
)
)
(initget 1)
(setq DIST (getdist (cadr ENT) "\n输入偏移距离:"))
(initget 1)
(setq PNT (getpoint (cadr ENT) "\n拾取方向:"))
(setq ENT1 (SEGMENTPTS ENT))
(if (/= (nth 2 ENT1) 0)
(setq ENT (CALCBULGE ENT1))
)
(if (/= (nth 2 ENT1) 0)
(if (> (nth 2 ENT1) 0)
(command "_.arc" "c" (nth 0 ENT) (nth 0 ENT1) (nth 1 ENT1))
(command "_.arc" "c" (nth 0 ENT) (nth 1 ENT1) (nth 0 ENT1))
)
(command "_.line" (nth 0 ENT1) (nth 1 ENT1) "")
)
(setq ENT2 (entlast))
(command "_.Offset" DIST ENT2 PNT "")
(entdel ENT2)
(setvar "osmode" HOLDOSMODE)
(command "_.undo" "_end")
(setvar "osmode" HOLDECHO)
(princ)
)

;;前生兄等等!!还有这个!! 
;;By LUCAS(龙龙仔) 
(defun C:PLINEOFFSET (/ HOLDECHO HOLDOSMODE ENT ENT1 ENT2 DIST PNT) 
 
  (defun SEGMENTPTS (ENT / PNT VOBJ PARAM1 PARAM2 P1 P2 SEGPTS) 
    (and 
      (setq VOBJ (vlax-ename->vla-object (car ENT))) 
      (setq PNT (trans (cadr ENT) 1 0)) 
      (setq PNT (vlax-curve-getclosestpointto VOBJ PNT)) 
      (setq PARAM1 (vlax-curve-getparamatpoint VOBJ PNT)) 
      (setq PARAM1 (fix PARAM1)) 
      (setq PARAM2 (1+ PARAM1)) 
      (if (equal PARAM1 (vlax-curve-getstartparam VOBJ) 1e-10) 
        (setq P1 (vlax-curve-getstartpoint VOBJ)) 
        (setq P1 (vlax-curve-getpointatparam VOBJ PARAM1)) 
      ) 
      (if (equal PARAM2 (vlax-curve-getendparam VOBJ) 1e-10) 
        (setq P2 (vlax-curve-getendpoint VOBJ)) 
        (setq P2 (vlax-curve-getpointatparam VOBJ PARAM2)) 
      ) 
      P1 
      P2 
      (setq BULGE (vla-getbulge VOBJ PARAM1)) 
      (setq SEGPTS (list P1 P2 BULGE)) 
    ) 
    SEGPTS 
  ) 
 
  (defun CALCBULGE (ENT / ARCRAD CENDIR HLFANG) 
    (setq VX1 (nth 0 ENT) 
          VX2 (nth 1 ENT) 
          BLG (nth 2 ENT) 
    ) 
    (setq HLFANG (* 2 (atan BLG)) 
          CENDIR ((if (< BLG 0) 
                    - 
                    + 
                  ) 
                   (- (angle VX1 VX2) HLFANG) 
                   (/ pi 2) 
                 ) 
          ARCRAD (abs (/ (/ (distance VX1 VX2) 2.0) (sin HLFANG))) 
    ) 
    (list 
      (polar VX1 CENDIR ARCRAD) 
      ARCRAD 
      (* (abs HLFANG) 2.0) 
    ) 
  ) 
 
  (setq HOLDECHO (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (command "_.undo" "_group") 
  (setq HOLDOSMODE (getvar "osmode")) 
  (setvar "osmode" 0) 
  (while (null ENT) 
    (prompt "\n拾取POLYLINE要偏移的段: ") 
    (setq ENT (ssget ":S" '((0 . "*POLYLINE")))) 
  ) 
  (setq        ENT (list (ssname ENT 0) 
                  (osnap (cadr (nth 3 (car (ssnamex ENT 0)))) "nea") 
            ) 
  ) 
  (initget 1) 
  (setq DIST (getdist (cadr ENT) "\n输入偏移距离:")) 
  (initget 1) 
  (setq PNT (getpoint (cadr ENT) "\n拾取方向:")) 
  (setq ENT1 (SEGMENTPTS ENT)) 
  (if (/= (nth 2 ENT1) 0) 
    (setq ENT (CALCBULGE ENT1)) 
  ) 
  (if (/= (nth 2 ENT1) 0) 
    (if        (> (nth 2 ENT1) 0) 
      (command "_.arc" "c" (nth 0 ENT) (nth 0 ENT1) (nth 1 ENT1)) 
      (command "_.arc" "c" (nth 0 ENT) (nth 1 ENT1) (nth 0 ENT1)) 
    ) 
    (command "_.line" (nth 0 ENT1) (nth 1 ENT1) "") 
  ) 
  (setq ENT2 (entlast)) 
  (command "_.Offset" DIST ENT2 PNT "") 
  (entdel ENT2) 
  (setvar "osmode" HOLDOSMODE) 
  (command "_.undo" "_end") 
  (setvar "osmode" HOLDECHO) 
  (princ) 
)

梦断江南 · 发表于 2003-5-8 13:08:32

6贴的程序看内容只是对整个实体offset,不是对pl线某个线段进行操作,和本主题讨论的问题有些偏差.龙龙仔的没细看,但是最后用了"arc""line"模拟,是不是会丢失宽度信息?我以为xd的处理方法更原滋原味一些.
过两天我也写一个,今天提工作图,被各专业追杀的紧

前生 · 发表于 2003-5-8 14:19:22

呵呵，不是啊
其实，6楼的已经很不错了,用了一个
nentselp,呵呵。

梦断江南 · 发表于 2003-5-8 19:11:17

喔,我马上试了一下,是可以.但是6贴对处理有宽度变换的线段时候出错.lucas的则正常,可惜也是没有保留宽度信息.另外,因为用的是Offset原理,和首贴提出的copy一段......不同,不知是不是前生表达错误?

aeo · 发表于 2003-5-9 00:10:23

6贴和8贴都不对,不是offset,要的是copy.
晓东的方法,先删不要的,再move.
还有方法就是,先得到那段的所有信息,原地重建,再move.

XDSoft · 发表于 2003-5-9 00:15:41

最初由 aeo 发布
[B]6贴和8贴都不对,不是offset,要的是copy.
晓东的方法,先删不要的,再move.
还有方法就是,先得到那段的所有信息,原地重建,再move. [/B]

如果得到段信息，那么程序要复杂，出错（不能重建信息）的概率要大，因为信息很多，还有是否拟和，弧段等等。

用删除没有用顶点的方法，应该是快捷的。代码也很短。

aeo · 发表于 2003-5-9 01:07:47

最初由 XDSoft 发布
[B]

如果得到段信息，那么程序要复?.. [/B]

我的来了,当然你说的对的.
1点了.半个小时

(defun c:copypl (/ e ee from to copypl)
(prompt "\nBY AEO ,一定要选"LWPOLYLINE" ")
(defun copypl (e from to / a b en f is j len li)
(defun make-pl (ptn / li)
(setq li (append
(list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '
(100 . "AcDbPolyline") (cons 90 2)
)
ptn
)
)
(entmake li)
(entlast)
)
(setq en (entget e)
is (dxf 70 en)
)
(setq en (member (assoc 10 en) en)
li '()
)
(while (>= (length en) 4)
(setq a (list (car en) (cadr en) (caddr en) (cadddr en))
en (cddddr en)
li (cons a li)
)
)
(if (= is 1)
(setq li (reverse (cons (last li) li)))
(setq li (reverse li))
)
(setq a (car li)
li (cdr li)
j 0
len (length li)
)
(while (< j len)
(setq b (nth j li)
f (make-pl (append
a
b
)
)
)
(if (vlax-curve-getParamAtPoint (vlax-ename->vla-object f) from)
(progn
(setq j len)
(command "move" f "" from to)
)
(entdel f)
)
(setq j (1+ j)
a b
)
)
)
(if (and
(setq ee (entsel))
(setq e (car ee)
from (cadr ee)
)
(= "LWPOLYLINE" (dxf 0 (entget e)))
(setq from (vlax-curve-getClosestPointTo
(vlax-ename->vla-object e)
from
)
)
(setq to (getpoint from "\nCopy To:"))
)
(copypl e from to)
)
(princ)
)

(defun c:copypl (/ e ee from to copypl) 
 (prompt "\nBY AEO ,一定要选"LWPOLYLINE" ") 
  (defun copypl (e from to / a b en f is j len li) 
    (defun make-pl (ptn / li) 
      (setq li (append 
                 (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") ' 
                       (100 . "AcDbPolyline") (cons 90 2) 
                 ) 
                 ptn 
               ) 
      ) 
      (entmake li) 
      (entlast) 
    ) 
    (setq en (entget e) 
          is (dxf 70 en) 
    ) 
    (setq en (member (assoc 10 en) en) 
          li '() 
    ) 
    (while (>= (length en) 4) 
      (setq a (list (car en) (cadr en) (caddr en) (cadddr en)) 
            en (cddddr en) 
            li (cons a li) 
      ) 
    ) 
    (if (= is 1) 
      (setq li (reverse (cons (last li) li))) 
      (setq li (reverse li)) 
    ) 
    (setq a (car li) 
          li (cdr li) 
          j 0 
          len (length li) 
    ) 
    (while (< j len) 
      (setq b (nth j li) 
            f (make-pl (append 
                         a 
                         b 
                       ) 
              ) 
      ) 
      (if (vlax-curve-getParamAtPoint (vlax-ename->vla-object f) from) 
        (progn 
          (setq j len) 
          (command "move" f "" from to) 
        ) 
        (entdel f) 
      ) 
      (setq j (1+ j) 
            a b 
      ) 
    ) 
  ) 
  (if (and 
        (setq ee (entsel)) 
        (setq e (car ee) 
              from (cadr ee) 
        ) 
        (= "LWPOLYLINE" (dxf 0 (entget e))) 
        (setq from (vlax-curve-getClosestPointTo 
                                                 (vlax-ename->vla-object e) 
                                                 from 
                   ) 
        ) 
        (setq to (getpoint from "\nCopy To:")) 
      ) 
    (copypl e from to) 
  ) 
  (princ) 
)

zhynt · 发表于 2003-5-9 04:19:02

我看了上面的图片，觉得直线段还行，但是弧线段更象是平移而不是偏移。如图：平移和偏移的区别

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

[LISP程序]：请大家看看,里面的问题

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [LISP程序]：请大家看看,里面的问题

点评

呵呵，不是啊