保证图块内两点都在曲线上的沿曲线“阵列”图块的实现

Lispboy

朋友让我看个图片，问我这类问题怎么做，他说能不能阵列的时候图块内的两个点保持在曲线上，如图：





其实，这类问题他没看对实质，这不是阵列的操作，因为阵列是一个刚体的整体的移动复制，要想保持两个点都在曲线上，那这个刚体除了移动外一定还有旋转，所以这个问题实质是：ALIGN 对齐的问题。


关键点是找到图块在曲线上两个点的坐标， 然后图块内那两点 对齐到曲线上两点就OK了。


所以，如何求出曲线上对应的两个点呢？


这就引申出，求曲线上指定起点，弦长（图块两点的长度）等于固定值，求弦第二点的算法（根据弦长反算曲线上点）。


这个算法实现见开源函数库：XD::Curve:GetPointAtChord

弦长第二点算出后，剩下就是很容易解决的了，在曲线上从开始点循环求出所有的起点接终点的“弦”所有点对，图块两点连线对齐到这个“弦” 就可以了。


下面代码使用XDRX API的 对齐 函数和曲线相关函数用了几行代码就完成了我们的要求：


先看下演示图片：




下面是程序代码：

(defun c:tt()
   (if (and (setq e (car (xdrx_entsel "\n拾取曲线<退出>:" '((0 . "*line,arc,ellipse,circle")))))
            (setq e1 (car (xdrx_entsel "\n拾取块<退出>:"  '((0 . "insert")))))
       )
     (progn
        (setq ents (xdrx_block_getentities e1 '((0 . "circle")))
              mat (xdrx_matrix_block2wcs e1)
              p1 (xdrx_getpropertyvalue (nth 2 ents) "center")
              p2 (xdrx_getpropertyvalue (nth 3 ents) "center")
              p1 (xdrx_point_transform p1 mat)
              p2 (xdrx_point_transform p2 mat)  ;;p1 p2 是图块内圆的两个圆心
        )
        (setq spt (xdrx_getpropertyvalue e "startpoint")
              ept (xdrx_getpropertyvalue e "endpoint")
         )         (xdrx_document_setprec 1e-5 1)
        (while (setq ept1 (xd::curve:getpointatchord e spt ept (distance p1 p2)))  ;;循环求出所有“弦”
           (xdrx_entity_copy e1)
           (xdrx_entity_align (entlast) p1 p2 spt ept1) ;;图块圆心连线对齐到曲线上的“弦”
           (setq spt ept1)
        )
     )
   )
   (princ)
)

marting

啥也不说了，感谢楼主分享哇！

yoyoho

感谢 Lispboy 分享实用程序!!!!!

守仁格竹GM

正需要，支持楼主大人了！

whdong76

啥也不说了，感谢楼主分享哇！

panliang9

@Lispboy
楼主你好，我从明经论坛赶过来的，我在明经发了一贴，
http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid781098

就是请教这个问题，明经的“高飞鸟”版主指点我到这里来的，看来你完美的解决了这个问题。
但现在问题是我的CAD装了“晓东CAD”总是出问题，直接使用你上面所述的程序，又总是提醒缺函数：
“no function definition: XDRX_ENTSEL”

楼主能不能费心，帮人帮到底，把晓东的函数合并到你上面所述的代码中去，这样，这个程序就完美了。

谢谢了！

这个问题从2012年明经上的这个贴子开始：
http://bbs.mjtd.com/forum.php?mo ... A%CF%DF%D5%F3%C1%D0

希望能在你这里得到一个完美的解答！！！

newer

panliang9 发表于 2016-10-10 23:05

LISPBOY的代码使用了XDRX API 用ARX写的LISP函数库，提示你错误是因为你没加载XDRX API和晓东通用LISP函数库。库是免费的，去这个帖子看看论坛插件的使用方法。http://bbs.xdcad.net/thread-670393-1-1.html

最快的方法就是下载安装晓东工具箱，安装后，API环境就搭建好了，论坛上的插件可以直接加载就用了。

你让他把API函数和这个LISP代码打包为难他了，API是个很庞大的库。 你自己加载它就OK了。

panliang9

http://bbs.xdcad.net/thread-705729-1-1.html

"newer" 版主，感谢你的回复！

今早我才看到，我今早按你给的使用方法，将“xd-lisp-lib.VLX”  还有通用函数库“XDRx.2007”都加载到了我的

AUTOCAD2007里了。

程序执行后，要求首先选择曲线，然后选择块对象，但返回一个提示“; 错误: 参数类型错误: 二维/三维点: nil”

附件内是我的图形，还有执行过程的动画。我相信这个程序肯定是没有问题的，是我的API没有加载对吗？

Lispboy

panliang9 发表于 2016-10-11 09:47

我那个代码，为了减少块内对齐点的拾取，直接代码读出了块的两个圆心，因为我的图是4个圆，而你的图是2个圆，所以代码出错了，


对应你这个图，代码这样就行了，看里面的注释。

(defun c:tt()
   (if (and (setq e (car (xdrx_entsel "\n拾取曲线<退出>:" '((0 . "*line,arc,ellipse,circle")))))
            (setq e1 (car (xdrx_entsel "\n拾取块<退出>:"  '((0 . "insert")))))
       )
     (progn
        (xdrx_begin)
        (setq ents (xdrx_block_getentities e1 '((0 . "circle")))
              mat (xdrx_matrix_block2wcs e1)
              p1 (xdrx_getpropertyvalue (car ents) "center") ;;两个块内圆的圆心，P1，P2
              p2 (xdrx_getpropertyvalue (cadr ents) "center")
              p1 (xdrx_point_transform p1 mat)
              p2 (xdrx_point_transform p2 mat)
        )
        (setq spt (xdrx_getpropertyvalue e "startpoint")
              ept (xdrx_getpropertyvalue e "endpoint")
         )
         (xdrx_document_setprec 1e-3 1)
        (while (setq ept1 (xd::curve:getpointatchord e spt ept (distance p1 p2)))
           (xdrx_entity_copy e1)
           (xdrx_entity_align (entlast) p1 p2 spt ept1)
           (setq spt ept1)
        )
        (xdrx_end)
     )
   )
   (princ)
)

如果要更通用，那就得多两次交互去拾取块内的两个对齐点，更通用的版本下面代码：

(defun c:tt ()
  (if (and
        (setq e (car (xdrx_entsel "\n拾取曲线<退出>:" '((0 . "*line,arc,ellipse,circle")))))
        (setq e1 (car (xdrx_entsel "\n拾取块<退出>:" '((0 . "insert")))))
        (setq p1 (getpoint "\n图块内第一点<退出>:"))
        (setq p2 (getpoint "\n图块内对齐第二点<退出>"))
      )
    (progn
      (xdrx_begin)
      (setq spt (xdrx_getpropertyvalue e "startpoint")
            ept (xdrx_getpropertyvalue e "endpoint")
      )
      (xdrx_document_setprec 1e-3 1)
      (while (setq ept1 (xd::curve:getpointatchord e spt ept
                                                   (distance p1 p2)
                        )
             )
        (xdrx_entity_copy e1)
        (xdrx_entity_align (entlast) p1 p2 spt ept1)
        (setq spt ept1)
      )
      (xdrx_end)
    )
  )
  (princ)
)

你试试，如果成，做个动画上来看看。用API写程序代码很短，你可以试试对着手册，看每个函数的作用，自己修改代码适合自己的使用。最新的晓东通用LISP函数库，XD::Curve:GetPointAtChord已经包含在里面了，你加载了函数库就能用上面代码了。

panliang9

非常开心，

成了！

太感谢“lispboy”  了，也感谢咱们的版主“newer",  ”这个程序对于二维机械设计中链条的表现非常重要，现阶段我知道的似乎仅仅有mechanical desktop 能画链条，但如果是不规则的链距，MDT也没办法做，我国外也搜了，都没找到合适的！

也许有人藏私，没有把相应的程序放出来，如果不是这样的话，这应该是唯一一个程序！

唯一的一个问题，就是真实的链条都闭合的，就是一条闭合的曲线，在MDT软件中需要首先在曲线中选中一个点，然后再选定链扣生成的方向，但这个问题都不大了。已经很好了。

我会把这个程序贴到明经的我原来的哪个贴子中去，注明是你的大作。

今天真高兴！