设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 开源函数库 › （XD::Curve:Vertices）获得曲线的顶点列表
返回列表 发新帖
查看: 1331|回复: 6

[曲线] （XD::Curve:Vertices）获得曲线的顶点列表

[复制链接]
Lispboy

已领礼包: 51个

财富等级: 招财进宝
发表于 2017-5-15 22:28:05 | 显示全部楼层 |阅读模式
函数发布
函数名称: XD::Curve:Vertices
调用格式: (XD::Curve:Vertices ent)
参数说明: ent --- 曲线实体（POINT,LINE,ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE）
返回值: 表
函数简介: 获得曲线的顶点列表
函数来源: 原创
函数作者: Lispboy
适用版本: 不限 
最后更新时间: 2017-05-15
备注: 支持：POINT,LINE,ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE
演示图片: -

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

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

×
  1. (defun XD::Curve:Vertices ( ent / der di1 di2 di3 elst fun inc lst par rad )
  2.     (setq elst (entget ent))
  3.     (cond
  4.         (   (eq "POINT" (cdr (assoc 0 elst)))
  5.             (list (cdr (assoc 10 elst)))
  6.         )
  7.         (   (eq "LINE" (cdr (assoc 0 elst)))
  8.             (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
  9.         )
  10.         (   (member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
  11.             (setq di1 0.0
  12.                   di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
  13.                   inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
  14.                   fun (if (vlax-curve-isclosed ent) < <=)
  15.             )
  16.             (while (fun di1 di2)
  17.                 (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  18.                       di1 (+ di1 inc)
  19.                 )
  20.             )
  21.             (reverse lst)
  22.         )
  23.         (   (or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
  24.                 (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80)))
  25.             )
  26.             (setq par 0)
  27.             (repeat (fix (1+ (vlax-curve-getendparam ent)))
  28.                 (if (setq der (vlax-curve-getsecondderiv ent par))
  29.                     (if (equal der '(0.0 0.0 0.0) 1e-8)
  30.                         (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
  31.                         (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
  32.                                   di1 (vlax-curve-getdistatparam ent par)
  33.                                   di2 (vlax-curve-getdistatparam ent (1+ par))
  34.                             )
  35.                             (progn
  36.                                 (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
  37.                                 (while (< di1 di2)
  38.                                     (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  39.                                           di1 (+ di1 inc)
  40.                                     )
  41.                                 )
  42.                             )
  43.                         )
  44.                     )
  45.                 )
  46.                 (setq par (1+ par))
  47.             )
  48.             (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-8))
  49.                 (reverse lst)
  50.                 (reverse (cons (vlax-curve-getendpoint ent) lst))
  51.             )
  52.         )
  53.         (   (eq (cdr (assoc 0 elst)) "ELLIPSE")
  54.             (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
  55.                   di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  56.                   di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))))
  57.             )
  58.             (while (< di1 di2)
  59.                 (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  60.                       der (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1)))
  61.                       di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
  62.                 )
  63.             )
  64.             (if (vlax-curve-isclosed ent)
  65.                 lst
  66.                 (setq lst (cons (vlax-curve-getendpoint ent) lst))
  67.             )
  68.             (reverse lst)
  69.         )
  70.         (   (eq (cdr (assoc 0 elst)) "SPLINE")
  71.             (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
  72.                   di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  73.                   inc (/ di2 25.0)
  74.             )
  75.             (while (< di1 di2)
  76.                 (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  77.                       der (/ (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1))) inc)
  78.                       di1 (+ di1 (if (equal 0.0 der 1e-10) inc (min inc (/ 1.0 der (* 10. inc)))))
  79.                 )
  80.             )
  81.             (if (vlax-curve-isclosed ent)
  82.                 lst
  83.                 (setq lst (cons (vlax-curve-getendpoint ent) lst))
  84.             )
  85.             (reverse lst)
  86.         )
  87.     )
  88. )


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

使用道具 举报

ynhh

已领礼包: 6881个

财富等级: 富甲天下
发表于 2017-5-16 08:25:51 | 显示全部楼层
感谢大师的分享
能不能来个应用实例啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

newer

已领礼包: 40个

财富等级: 招财进宝
发表于 2017-5-16 08:44:25 | 显示全部楼层
ynhh 发表于 2017-5-16 08:25

  1. (defun c:tt ()
  2.   (princ "\n选取曲线<退出>:")
  3.   (if (setq e (ssget ":E:S" '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
  4.     (progn
  5.       (princ "\n顶点列表：")
  6.       (princ (xd::curve:vertices (ssname e 0)))
  7.     )
  8.   )
  9.   (princ)
  10. )


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

使用道具 举报

ynhh

已领礼包: 6881个

财富等级: 富甲天下
发表于 2017-5-16 08:46:40 | 显示全部楼层
本帖最后由 ynhh 于 2017-5-16 08:51 编辑

感谢感谢
两位大师
请教大师，以下的写法是什么意思啊？
":E:S"
"_+.:E:S"


谢谢

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

使用道具 举报

原地踏步

已领礼包: 5188个

财富等级: 富甲天下
发表于 2017-5-17 20:37:38 | 显示全部楼层
这个不错，收藏了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

1121443108qaz

已领礼包: 28个

财富等级: 恭喜发财
发表于 2018-6-10 00:59:34 来自手机 | 显示全部楼层
inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))inc是什么，为什么这么算
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-11-22 01:41 , Processed in 0.191733 second(s), 43 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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