[LISP程序]：好难的程序，请大虾们帮忙。。

shona521

经过我一段时间的学习，有了一丁点的进步，感叹初学lisp的艰难的同时，对论坛上的高手们也佩服得五体投地。

请高手帮忙修改一下下面的程序。不胜感激。
本程序已提取pline最长线段两端点坐标，不过还有几个问题：
1、循环好像有点问题。
2、如何用 “mirror”命令镜像pline，我不懂怎么点选pline提取了端点坐标后，镜像时如何自动选择刚才点选的pline.


本程序用途：选择每条pline，沿选择的pline最长的线段镜像pline，并删除镜像前的pline。

结果如图。等ing

[PHP];;;******将选择的pline沿最长那条线段镜像,直到不再选择退出*******
(defun c:fx ()
   (setvar "cmdecho" 0)
   (setq s1 (entsel "\n\t选择对象<退出> : "))
   (setq ss (entget (car s1)))
   (while ss (progn
      (xdd)      
   ;(command "mirror" dd1 dd2 "n")  ;将选中的pline沿本身最长的线段像
             )
   )
  (setq s1 (entsel "\n\t选择对象<退出> : "))
  (setq ss (entget (car s1)))
)


;;;****************pline沿最长那条线段端点**********************
(defun xdd(/  eobj i leng pt0 pt1)  
  (setq s1 (entsel)
      eobj (vlax-ename->vla-object (car s1))
        i    0
    Leng-max 0
  )
  
  (while (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
    (if    (setq pt1 (vlax-curve-getPointAtParam eobj (setq n (1+ i))))
      (progn
      (setq Leng (distance pt0 pt1))
      (if (> leng leng-max)
      (setq    ptmax0 pt0
        ptmax1 pt1
        number i
        leng-max leng
      )
      )  
      )
    )
  )
;********************取出ptmax0,ptmax1(二维点)***************

  (setq px1 (car ptmax0)) (setq py1 (cadr ptmax0)) ;端点1的x,y坐标
  
  (setq px2 (car ptmax1)) (setq py2 (cadr ptmax1)) ;端点2的x,y坐标
                 
  (setq dd1 (list px1 py1)) (setq dd2 (list px2 py2))
  
  (princ dd1)(princ dd2)
)
(prin1)
(prin1 "\n ***************************FX**************")[/PHP]

狂刀

这是论坛上某人写的吧？
我最反感不署名作者，应该尊重别人的劳动

zxq0220

将
;(command "mirror" dd1 dd2 "n")
改为
(command "mirror" (car s1) "" dd1 dd2 "y")
即可

shona521

对不起狂刀大哥了。本人初学lisp，看到论坛的高手们都如此厉害。用lisp实现了很多功能。可是想自己改进一下以使程序更加适合自己。这个程序贴的时候是借鉴了论坛某高手的程序（后来经查是 “狂刀”），狂刀大哥提出来了，请接受我真诚的道歉：对不起，我以后借鉴程序的时候一定会说明出处。我出于学习请教之心，相信大哥可以理解。
初学lisp觉得很难。现在也觉得没有上手。还请高手们多多指教，多多帮忙。
如果有什么做法不妥，也请大虾们多多海涵。

狂刀

不是吧，我只是在哪里看到过，我好像没写过这个功能的程序。

xyp1964

有点像偶的某个程序（test102，多义线逐段长度计算并显示和标注最长线段两端的坐标），能举一反三的加以应用就挺好！继续努力！

shona521

对不起xyp1964，我看的那篇帖子上面有你的程序，也有狂刀兄的程序。只查了帖子没有细查，真不好意思。不过都要感谢大家，让我在xdcad上进步了许多。谢谢zxq0220  ，程序已经改好，可以用了。

xyp1964

这样可能更简洁：
[php]
;;;以多义线中最长线段为轴镜像并删除原实体
(defun c:test ()
  (setq        s1         (entsel "\n\t选择对象<退出> : ")
        eobj         (vlax-ename->vla-object (car s1))
        i         -1
        Leng-max 0
  )
  (while (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
    (if        (setq pt1 (vlax-curve-getPointAtParam eobj (setq n (1+ i))))
      (progn
        (setq Leng (distance pt0 pt1))
        (if (> leng leng-max)
          (setq        ptmax0 pt0
                ptmax1 pt1
                leng-max leng
          )
        )
      )
    )
  )
  (command "mirror" (car s1) "" ptmax0 ptmax1 "Y")
  (princ)
)
[/php]

lengliqun

xyp1964 程序可用，再问能将对称轴改为　1.平行pline最长那条线段(上面程序已经做到了)　2.过整个PLINE线的形心(假设有条线将该PLINE线首尾连接了，这封闭区域将有个形心)

xyp1964

只知“质心”，不知“形心”是什么？
“2.过整个PLINE线的形心(假设有条线将该PLINE线首尾连接了，这封闭区域将有个形心)  ）”到底何意，看不懂！

lengliqun

附件有说明

xyp1964

不知可行?
[php]
(load "xyp_lib")
;|
加载通用函数
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
下载地址：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
如果已在acad.lsp中添加了(load "xyp_lib")，可以直接运行下面的程序。
|;

;;;以多义线质心为轴旋转之
(defun c:test ()
  (cmdla0)
  (setq        s1   (car (entsel "\n\t选择对象<退出> : "))
        eobj (vlax-ename->vla-object s1)
  )
  (if (or (= (dxf 0 (entget s1)) "LWPOLYLINE")
          (= (dxf 0 (entget s1)) "POLYLINE")
      )
    (progn
      (mkla "辅助线" 1)
      (setq pt_start (x_startP eobj)
            PT_END   (X_ENDP eobj)
      )
      (command "line" pt_start PT_END "")
      (setq e1          (entlast)
            pt-ro (zxd)
            ang          (ureal 1 "" "\n旋转角度" ang)
      )
      (command "rotate" s1 "" pt-ro ang)
    )
  )
  (entdel e1)
  (cmdla1)
)
[/php]

lengliqun

谢谢，可以用啊。能否再编一LSP，以质心为中心旋转180度。要求180度含在您的LSP中，以方便我以后改成其它角度，谢谢。

xyp1964

[php]
(load "xyp_lib")
;|
加载通用函数
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
下载地址：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
如果已在acad.lsp中添加了(load "xyp_lib")，可以直接运行下面的程序。
|;

;;;以多义线质心为轴旋转之
(defun c:test ()
  (cmdla0)
  (setq    s1   (car (entsel "\n\t选择对象<退出> : "))
    eobj (vlax-ename->vla-object s1)
  )
  (if (or (= (dxf 0 (entget s1)) "LWPOLYLINE")
      (= (dxf 0 (entget s1)) "POLYLINE")
      )
    (progn
      (mkla "辅助线" 1)
      (setq pt_start (x_startP eobj)
        PT_END   (X_ENDP eobj)
      )
      (command "line" pt_start PT_END "")
      (setq e1      (entlast)
        pt-ro (zxd)
        ang      (ureal 1 "" "\n旋转角度" 180)
      )
      (command "rotate" s1 "" pt-ro ang)
    )
  )
  (entdel e1)
  (cmdla1)
)
[/php]

lengliqun

选择区域内一点<退出> :
已提取 1 个环。

已创建 1 个面域。

BOUNDARY 已创建 1 个面域



对14楼程序，能否删去　已创建 1 个面域　的功能，直接饶质心转180度可以了，麻烦了。谢谢！我可不是太想在其中间再点一下。