找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2090|回复: 5

[研讨] [API应用]画线标注

[复制链接]

已领礼包: 1268个

财富等级: 财源广进

发表于 2016-5-25 09:49:40 | 显示全部楼层 |阅读模式

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

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

×

测试

  1. (defun c:tt (/ ss p1 p2 v _inters p an)
  2.   (defun _inters (p1 p2 e / pts ln2d gelst com2d typ ptl)
  3.     (if        (and (setq typ (car (xdrx_getpropertyvalue e "ClassName")))
  4.              (setq ln2d (xdge::constructor "kLineSeg2d" p1 p2))
  5.         )
  6.       (progn
  7.         (cond
  8.           ((= typ "HATCH") (setq pts (xdrx_geom_searchoutline e)))
  9.           ((= typ "INSERT") (setq pts (xdrx_entity_box e)))
  10.           (t)
  11.         )
  12.         (and pts
  13.              (setq gelst (mapcar '(lambda (x) (xdge::constructor "kLineSeg2d" (car x) (cadr x)))
  14.                                  (xd::list:snakepair (xd::pnts:close pts))
  15.                          )
  16.              )
  17.              (setq com2d (xdge::constructor "kCompositeCrv2d" gelst))
  18.              (setq cc (xdge::constructor "kCurveCurveInt2d" ln2d com2d)
  19.                    n  -1
  20.              )
  21.              (repeat (xdge::getpropertyvalue cc "numIntPoints")
  22.                (setq ptl (cons (xdge::getpropertyvalue cc "intPoint" (setq n (1+ n))) ptl))
  23.              )
  24.         )
  25.       )
  26.     )
  27.     (xdge::free)
  28.     (setq v (mapcar '- p2 p1))
  29.     ptl
  30.   )
  31.   (defun _sort (p1 p2 ptl / v)
  32.     (setq v (mapcar '- p2 p1))
  33.     (vl-sort ptl
  34.              '(lambda (x1 x2)
  35.                 (< (last (trans (mapcar '- x1 p1) 0 v))
  36.                    (last (trans (mapcar '- x2 p1) 0 v))
  37.                 )
  38.               )
  39.     )
  40.   )
  41.   (if (and (setq p1 (getpoint "\nFirst Point: "))
  42.            (setq p2 (getpoint p1 "\nSecond Point: "))
  43.            (if (> (angle p1 p2) _pi2)
  44.              (mapcar 'set '(p1 p2) (list p2 p1))
  45.              t
  46.            )
  47.            (xdrx_grdraw 1 p1 p2)
  48.            (setq v (xd::doc:getdist p1 nil nil (mapcar '- p2 p1) t))
  49.            (setq ss (ssget "F" (list p1 p2) '((0 . "*line,arc,circle,ellipse,insert,hatch"))))
  50.       )
  51.     (progn
  52.       (setq
  53.         lst (_sort
  54.               p1
  55.               p2
  56.               (xd::list:removedup
  57.                 (apply 'append
  58.                        (mapcar '(lambda        (x)
  59.                                   (if (member (car (xdrx_getpropertyvalue (cadr x) "ClassName")) '("HATCH" "INSERT"))
  60.                                     (_inters p1 p2 (cadr x))
  61.                                     (mapcar 'cadr (cdddr x))
  62.                                   )
  63.                                 )
  64.                                (ssnamex ss)
  65.                        )
  66.                 )
  67.               )
  68.             )
  69.         p   (mapcar '+ p1 v)
  70.         an  (angle p1 p2)
  71.       )
  72.       (mapcar '(lambda (a b)
  73.                  (xdrx_dimension_makerotate a b (mapcar '+ a v) an)
  74.                )
  75.               lst
  76.               (cdr lst)
  77.       )
  78.     )
  79.   )
  80.   (princ)
  81. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 19个

财富等级: 恭喜发财

发表于 2016-5-25 11:04:54 | 显示全部楼层
提供下测试结果,发现两种情况需要改进

1、填充给标注的时候,基线的位置不对
2、基线位置对的时候填充没给标注

看图
选线标注测试.gif

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

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

 楼主| 发表于 2016-5-25 13:07:28 来自手机 | 显示全部楼层
不知是系统原因还是API原因,再使用时Autocad崩溃了,排查中
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

 楼主| 发表于 2016-5-25 15:25:19 | 显示全部楼层
Lisphk 发表于 2016-5-25 11:04
提供下测试结果,发现两种情况需要改进

1、填充给标注的时候,基线的位置不对


这样改了下,很奇怪 Hatch 时灵时不灵

  1. (defun c:tt (/ ss p1 p2 v _inters p an)
  2.   (defun _inters (p1 p2 e / pts)
  3.     (if        (setq pts (xdrx_geom_searchoutline e))
  4.       (xdrx_curve_getinters (list p1 p2) (xd::pnts:setz pts 0.0))
  5.     )
  6.   )
  7.   (defun _sort (p1 p2 ptl / v)
  8.     (setq v (mapcar '- p2 p1))
  9.     (vl-sort ptl
  10.              '(lambda (x1 x2)
  11.                 (< (last (trans (mapcar '- x1 p1) 0 v))
  12.                    (last (trans (mapcar '- x2 p1) 0 v))
  13.                 )
  14.               )
  15.     )
  16.   )
  17.   (if (and (setq p1 (getpoint "\nFirst Point: "))
  18.            (setq p2 (getpoint p1 "\nSecond Point: "))
  19.            (if (< _pi2 (angle p1 p2) (* pi 1.5))
  20.              (mapcar 'set '(p1 p2) (list p2 p1))
  21.              t
  22.            )
  23.            (xdrx_grdraw 1 p1 p2)
  24.            (setq v (xd::doc:getdist p1 nil nil (mapcar '- p2 p1) t))
  25.            (setq ss (ssget "F" (list p1 p2) '((0 . "*line,arc,circle,ellipse,insert,hatch"))))
  26.       )
  27.     (progn
  28.       (setq
  29.         lst (_sort
  30.               p1
  31.               p2
  32.               (xd::list:removedup
  33.                 (apply 'append
  34.                        (mapcar '(lambda        (x)
  35.                                   (if (member (car (xdrx_getpropertyvalue (cadr x) "ClassName")) '("HATCH" "INSERT"))
  36.                                     (_inters p1 p2 (cadr x))
  37.                                     (mapcar 'cadr (cdddr x))
  38.                                   )
  39.                                 )
  40.                                (ssnamex ss)
  41.                        )
  42.                 )
  43.               )
  44.             )
  45.         p   (mapcar '+ p1 v)
  46.         an  (angle p1 p2)
  47.       )
  48.       (mapcar '(lambda (a b)
  49.                  (xdrx_dimension_makerotate a b (mapcar '+ a v) an)
  50.                )
  51.               lst
  52.               (cdr lst)
  53.       )
  54.     )
  55.   )
  56.   (princ)
  57. )

点评

那你在HATCH的代码下,加个打印语句, 看看不灵的时候HATCH返回的内容是需要的不  详情 回复 发表于 2016-5-25 15:40
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2016-5-25 15:40:18 | 显示全部楼层
st788796 发表于 2016-5-25 15:25
这样改了下,很奇怪 Hatch 时灵时不灵

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

使用道具 举报

已领礼包: 7个

财富等级: 恭喜发财

发表于 2018-12-1 18:00:24 | 显示全部楼层
本帖最后由 137407536 于 2019-3-8 11:59 编辑

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 18:13 , Processed in 0.394269 second(s), 45 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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