找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1093|回复: 11

[分享]:完善xyp的" 物体沿线均布"程序

[复制链接]
发表于 2006-4-2 13:55:46 | 显示全部楼层 |阅读模式

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

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

×
感谢xyp大侠提供的" 物体沿线均布"程序!
;;; 物体沿线均布
(defun c:test ()
  (CMDLA0)
  (setvar "osmode" 0)
  (setq        s1  (car (entsel "\n选择曲线: "))
        s2  (car (entsel "\n选择实体: "))
        no1 (UREAL 7 "" "\n实体与实体间距" no1)
        no2 (UREAL 7 "" "\n实体与曲线间距" no2)
        ptn (xyp-get-CurveDivPtlst s1 no1)
        pt5 (xyp-get-MinMaxPoint s2 5)        ;实体中心
  )
  (foreach pt ptn
    (setq pt0 (xyp-get-FaxianAtPoint s1 pt no2)
          ang (- (xyp-rad2ang (angle pt pt0)) 90.0)
    )
    (command "copy" s2 "" pt5 pt0)
    (command "rotate" (entlast) "" pt0 ang)
  )
  (CMDLA1)
)
经测试,对点(圆)状的实体均布可达到预期效果,但对线状有方向的实体就不能保证均布的实体与曲线垂直(水平)了.
经仔细研究,发现均布的实体都多旋转了一个角度,这个角度就等于第一个均布实体与被均布实体的夹角(ang0),如果每个均布的实体的旋转角都减去ang0,则均布的实体就与曲线垂直了.置于此,对程序作了补充,先计算出ang0,然后每个均布的实体都减去ang0就行了,另外,还要再删除最后一个均布的实体.修改后的程序如下;

;;; 实体沿线均布
(defun c:tes ()
  (CMDLA0)
  (setvar "osmode" 0)
  (setq        s1  (car (entsel "\n选择曲线: "))            ;选择实体均布的曲线
        s2  (car (entsel "\n选择实体: "))            ;选择被均布的实体
        no1 (UREAL 7 "" "\n实体与实体间距" no1)      ;输入实体均布的间距
        no2 (UREAL 7 "" "\n实体中点与曲线间距" no2)  ;输入实体中点与曲线的间距
        ptn (xyp-get-CurveDivPtlst s1 no1)           ;求曲线等分点坐标集
        pt5 (xyp-get-MinMaxPoint s2 5)                     ;求被均布实体的中心坐标
  )
    (setq ptt (car ptn))                                 ;从曲线等分点坐标集中提取第一个坐标
    (setq ang0 (- (xyp-rad2ang (angle ptt pt5)) 90.0))   ;计算第一个均布实体的旋转角
  (foreach pt ptn
    (setq pt0 (xyp-get-FaxianAtPoint s1 pt no2)                ;计算均布实体的中心坐标
          ang (- ang0 (- (xyp-rad2ang (angle pt pt0)) 90.0))   ;计算均布实体的旋转角
    )
    (command "copy" s2 "" pt5 pt0)                             ;粘贴实体
    (command "rotate" (entlast) "" pt0 ang)                    ;旋转实体
  )
(command "erase" "l" "")                                       ;删除最后一个粘贴的实体
  (CMDLA1)
)
                 (prompt "  <<实体沿线均布>>启动命令:tes")
                    (princ)
程序修改前后的效果如下图.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2006-4-11 12:38:15 | 显示全部楼层
最初由 aichong 发布
[B]
斑竹的才是垂直的,你修改后反而不垂直了。
请问斑竹:能不能选择方向... [/B]

实体与曲线间距改为负值。
  1. [FONT=courier new];;; 物体沿线均布
  2. (defun c:test ()
  3.   (CMDLA0)
  4.   (setvar "osmode" 0)
  5.   (setq        s1  (car (entsel "\n选择曲线: "))
  6.         s2  (car (entsel "\n选择实体: "))
  7.         no1 (UREAL 7 "" "\n实体与实体间距" no1)
  8.         no2 (UREAL 1 "" "\n实体与曲线间距" no2)
  9.         ptn (xyp-get-CurveDivPtlst s1 no1)
  10.         pt5 (xyp-get-MinMaxPoint s2 5)
  11.   )
  12.   (foreach pt ptn
  13.     (setq pt0 (xyp-get-FaxianAtPoint s1 pt no2)
  14.           ang (- (xyp-rad2ang (angle pt pt0)) 90.0)
  15.     )
  16.     (command "copy" s2 "" pt5 pt0)
  17.     (command "rotate" (entlast) "" pt0 ang)
  18.   )
  19.   (CMDLA1)
  20. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 1 反对 0

使用道具 举报

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

使用道具 举报

发表于 2006-4-8 23:30:43 | 显示全部楼层

Re: [分享]:完善xyp的" 物体沿线均布"程序

最初由 真龙天子 发布
[B]感谢xyp大侠提供的" 物体沿线均布"程序!
;;; 物体沿线均布
(defun c:test ()
  (CMDLA0)
  (setvar "osmode" 0)
  (setq        s1  (car (entsel "\n选择曲线: "))
        s2  (car (entsel "\n选择实体: "))
        no1 (UREAL... [/B]

不明白为何出来个ang0,用个方块试试,看看结果如何?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2006-4-9 16:36:20 | 显示全部楼层 |阅读模式

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

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

×
回斑竹:我为了达到线状的实体与曲线垂直的目的,所以才多出一个ang0来.结果见下图.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2006-4-11 10:02:27 | 显示全部楼层
最初由 真龙天子 发布
[B]回斑竹:我为了达到线状的实体与曲线垂直的目的,所以才多出一个ang0来.结果见下图. [/B]

斑竹的才是垂直的,你修改后反而不垂直了。
请问斑竹:能不能选择方向啊?比如可以选择向上或向下。好像你们的只能向上的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-4-11 21:22:18 | 显示全部楼层
可否改为自己设置基点,我们常用是自己定义基点再复制
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2006-4-11 22:50:18 | 显示全部楼层
再一次感谢xyp斑竹的帮助,可以说是斑竹带我进入lisp的大门的,我的每一次求助几乎都得到了他的帮助.本主题是我发起的,得到了斑竹两次光临帮助,深表感谢!并希望斑竹能看到本贴.
       在使用中,上面的程序确实有不尽人意之处,现已补充修改完善,下面的程序不考虑均布实体的形状,由自己确定实体垂直曲线的基点.
    (setvar "osmode" 0)
    (setq s1 (car (entsel "\n选择曲线: "))                    ;选择实体均布的曲线
          s2 (car (entsel "\n选择实体: ")))                   ;选择被均布的实体
    (setvar "osmode" 39)
    (setq ptm (getpoint "请确定垂直于曲线的点:"))            ;确定实体垂直于曲线的点
    (setvar "osmode" 0)
    (setq no1 (UREAL 7 "" "\n实体与实体间距" no1)             ;输入实体均布的间距
          no2 (UREAL 1 "" "\n实体中点与曲线间距<线左为+,线右为->" no2)         ;输入实体中点与曲线的间距
          ptn (xyp-get-CurveDivPtlst s1 no1)                  ;求曲线等分点坐标集
          pt5 (xyp-get-MinMaxPoint s2 5)                      ;求被均布实体的中心坐标
          n -1                                                ;从0开始计数
    )
    (foreach pt ptn                                           ;开始循环pt次
         (setq pt0 (xyp-get-FaxianAtPoint s1 pt no2)          ;计算均布实体的中心坐标
               pt5x (car pt5)
               pt5y (cadr pt5)
               ptmx (car ptm)
               ptmy (cadr ptm)
               pt0x (car pt0)
               pt0y (cadr pt0)
               ptmm (list (- pt0x (- pt5x ptmx)) (- pt0y (- pt5y ptmy)))  ;计算均布实体垂直于曲线点的坐标
               n (+ n 1)                                      ;计数器+1        
               ptr (nth n ptn))                               ;从曲线等分点坐标集中提取第一个坐标
         (command "copy" s2 "" pt5 pt0)                       ;粘贴实体
         (if (/= pt0 ptmm) (progn
             (setq ss (entlast))                                  ;将粘贴的实体放入SS
             (command "rotate" ss "" pt0 "r" pt0 ptmm ptr))       ;旋转实体
         )
    )    (command "erase" "l" "")                                  ;删除最后一个粘贴的实体
    (CMDLA1)
)
                 (prompt "  <<实体沿线均布>>启动命令:tes")
                    (princ)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2006-4-12 00:16:59 | 显示全部楼层
  1. [FONT=courier new](defun c:test ()
  2.   (CMDLA0)
  3.   (setvar "osmode" 0)
  4.   (setq        s1  (car (entsel "\n选择曲线: "))
  5.         s2  (car (entsel "\n选择实体: "))
  6.         no1 (UREAL 7 "" "\n实体与实体间距" no1)
  7.         no2 (UREAL 1 "" "\n实体与曲线间距" no2)
  8.         ptn (xyp-get-CurveDivPtlst s1 no1)
  9.         pt5 (xyp-get-MinMaxPoint s2 5)
  10.   )
  11.   (foreach pt ptn
  12.     (setq pt0 (xyp-get-FaxianAtPoint s1 pt no2)
  13.           ang (- (xyp-rad2ang (angle pt pt0)) 90.0)
  14.     )
  15.     (command "copy" s2 "" pt5 pt0)
  16.     (command "rotate" (entlast) "" pt0 ang)
  17.     (if        (< no2 0)
  18.       (command "rotate" (entlast) "" pt0 180)
  19.     )
  20.   )
  21.   (CMDLA1)
  22. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

使用道具 举报

已领礼包: 104个

财富等级: 日进斗金

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-12 05:48 , Processed in 0.446562 second(s), 58 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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