找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1314|回复: 2

[LISP函数]:应用快捷键可

[复制链接]
发表于 2005-10-27 09:59:35 | 显示全部楼层 |阅读模式

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

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

×
;|
命令:XDTB_ArrayByPath
功能:沿着指定的路径曲线(line,polyline,lwpolyline,spline,arc,circle,ellipse)
阵列选择的实体(选择集),可以保持实体相对路径的位置。

说明:程序计算出沿着指定路径可以阵列的最大数量,请输入小于等于这个最大值的数。

配合XDRX_API B11208以上版本使用

该程序演示了API 关于向量和矩阵转换的操作。
演示了如何把转换矩阵作用在实体上生成实体的拷贝

关于该程序的改进建议请到“晓东CAD空间” “开发论坛” 留言
http://www.chat001.com/forum/xdapply/index.html
|;

(defun c:XDTB_ArrayByPath (/           $get_point           $remake_l
                           ss           curve   dist           tf           num
                           maxnum  pnt           pntl           vect           xform
                           vT1           vT2           mMat1   mMat2   mRot
                           m0           mMat
                          )
  ;;构造曲线上点pnt至曲线结束点间间隔为dist的点表,和曲线方向有关系;
  ;;对ARC沿逆时针方向的起点才是起始点,阵列时注意选择集的相对位置。
  (defun $get_point (curve pnt dist / ptl pt dist1)
    (setq dist1 #xarray_dist);#xarray_dist 默认间隔
    ;从曲线起点dist1距离起计算一定间隔的点
    (while (setq pt (xdrx_curve_getpointatdist curve (+ dist dist1)))
      (setq dist1 (+ dist1 #xarray_dist)
            ptl          (cons (trans pt 1 0) ptl)
      )
    )
    (reverse ptl)
  )
  ;;取出表l中起始的num个原子
  (defun $remake_l (l num / ptl tf i)
    (setq ptl (reverse l))
    (if        (< num (length l))
      (progn
        (setq ptl nil)
        (setq tf t)
        (setq i 0)
        (while tf
          (if (< i num)
            (setq ptl (cons (nth i l) ptl)
                  i   (1+ i)
            )
            (setq tf nil)
          )
        )
      )
    )
    (reverse ptl)
  )
  (prompt "\n请选取要沿路径阵列的实体<退出>")
  (if (and
        (setq ss (ssget))
        (setq curve (car (xdrx_entsel
                           "\n点取一个路径(曲线)<退出>:"
                           '
                            ((0 . "*line,arc,circle,ellipse"))
                         )
                    )
        )
      )
    (progn
      (xdrx_begin)
      (xdrx_ucson)
      (if (not #xarray_dist)
        (setq #xarray_dist 100)
      )
      (redraw curve 3)
      (initget 6)
      (if (setq        dist (getreal (strcat "\n阵列距离<"
                                      (rtos #xarray_dist 2 2)
                                      ">:"
                              )
                     )
          )
        (setq #xarray_dist dist)
      )
      (setq box             (xdrx_entity_box ss) ;选择集包围盒
            cen             (xdrx_midp (car box) (caddr box)) ;cen包围盒中心
            ;;包围盒中心cen至曲线上最近点pnt
            pnt             (xdrx_curve_getClosestPoint curve cen)
            ;;pnt点的切向量
            vec1     (xdrx_curve_getFirstDeriv curve pnt)
            pnt             (trans pnt 1 0)        ;pnt(WCS)
            ;;点pnt至曲线起点的距离
            baseDist (xdrx_curve_GetDistAtPoint curve pnt)
            pntl     ($get_point curve pnt baseDist)
      )
      (initget 6)
      (setq maxnum (length pntl)
            tf           t
      )
      (while tf
        (setq num (getint (strcat "\n输入数量(该路径上最大允许数量"
                                  (itoa maxnum)
                                  ")<"
                                  (itoa maxnum)
                                  ">:"
                          )
                  )
              num (if (not num)
                    maxnum
                    num
                  )
              tf  (if (> num maxnum)
                    t
                    nil
                  )
        )
      )
      (setq pntl  ($remake_l pntl num);构造指定数量的曲线间隔点表
            m0          (xdrx_matrix_identity)
            xForm (mapcar
                    '(lambda (x)        ;构造每个曲线点的矩阵
                       (setq vFDeriv (xdrx_curve_GetFirstDeriv
                                       curve
                                       (trans x 0 1)
                                     )        ;点的切向量(WCS)
                             mRot    (xdrx_vector_rotateTo vec1 vFDeriv);pnt向量旋转
                             vT1     (mapcar '-
                                             (trans '(0 0 0) 0 1)
                                             (trans pnt 0 1)
                                     )        ;pnt位移向量
                             vT2     (mapcar '- (trans x 0 1) (trans '(0 0 0) 0 1));点的偏移向量
                             mMat1   (xdrx_matrix_setTranslation m0 vT1);pnt偏移矩阵
                             mMat2   (xdrx_matrix_setTranslation m0 vT2);点的偏移矩阵
                             mMat    (xdrx_matrix_product mRot mMat1);pnt处旋转
                             mMat    (xdrx_matrix_product mMat2 mMat);矩阵相乘       
                       )
                     )
                    pntl
                  )
      )
      ;;xForm-曲线上点与点pnt转换的矩阵表
      (mapcar
        '(lambda (x)
           (xdrx_entity_transformedcopy ss x) ;构造选择集拷贝
         )
        xForm
      )
      (redraw curve 4)
      (xdrx_ucsoff)
      (xdrx_end)
    )
  )
  (princ)

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2005-10-28 09:04:17 | 显示全部楼层
很有用,谢谢楼主了!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2005-10-28 17:01:45 | 显示全部楼层
谢谢楼主,东西真是不错。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-19 22:46 , Processed in 0.187636 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表