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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 晓东工具箱、编程申请 › 点选直线靠角点的边得出对角点
12下一页
返回列表 发新帖
查看: 2359|回复: 22

[求助] 点选直线靠角点的边得出对角点

[复制链接]
ymcui2005

已领礼包: 106个

财富等级: 日进斗金
发表于 2014-9-4 15:07:05 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

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

使用道具 举报

csharp

已领礼包: 859个

财富等级: 财运亨通
发表于 2014-9-4 15:14:03 来自手机 | 显示全部楼层
都是直线？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

csharp

已领礼包: 859个

财富等级: 财运亨通
发表于 2014-9-4 15:22:08 来自手机 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
既然是矩形点完就可以计算出来

点评

XDSoft
他没上DWG，不清楚，很可能最外面是一根长直线吧。  详情 回复 发表于 2014-9-4 15:37
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

XDSoft

已领礼包: 145个

财富等级: 日进斗金
发表于 2014-9-4 15:35:38 | 显示全部楼层
得到点要干啥？这个要求是工具吗？ 还是你想知道怎么得到对角点的代码，然后你再接着写代码？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

XDSoft

已领礼包: 145个

财富等级: 日进斗金
发表于 2014-9-4 15:37:30 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
csharp 发表于 2014-9-4 15:22
既然是矩形点完就可以计算出来

他没上DWG，不清楚，很可能最外面是一根长直线吧。

点评

ymcui2005
不好意思那个是多义线的距形,点选靠角落的地方得出对角点画距形.小距形方向全部向内面.谢谢  详情 回复 发表于 2014-9-4 15:50
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ymcui2005

已领礼包: 106个

财富等级: 日进斗金
 楼主| 发表于 2014-9-4 15:46:59 | 显示全部楼层
(DEFUN C:cd()
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq nm 0)
           (setq test t)
           (while test
                  (setq ss (entsel "\n请点选矩形:"))
                  (setq test (not ss))
           )
(command "LAYER" "S" (cdr (assoc 8 (entget (car ss)))) "" )
(setq obj (vlax-ename->vla-object (car ss)))
(setq PT2 (vlax-curve-getclosestpointto obj (cadr ss)))
(setq pta (osnap pt2 "end"))
(COMMAND "_RECTANG" pta 对角点);pta为角点,画出小距形
(princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ymcui2005

已领礼包: 106个

财富等级: 日进斗金
 楼主| 发表于 2014-9-4 15:50:58 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
XDSoft 发表于 2014-9-4 15:37
他没上DWG，不清楚，很可能最外面是一根长直线吧。

不好意思那个是多义线的距形,点选靠角落的地方得出对角点画距形.小距形方向全部向内面.谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ymcui2005

已领礼包: 106个

财富等级: 日进斗金
 楼主| 发表于 2014-9-4 15:55:50 | 显示全部楼层
已有多义线的大距形,要求点选靠角落的地方得出对角点画出小距形.小距形方向全部向内面.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

csharp

已领礼包: 859个

财富等级: 财运亨通
发表于 2014-9-4 16:04:37 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
要定长、宽啊

点评

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

使用道具 举报

ymcui2005

已领礼包: 106个

财富等级: 日进斗金
 楼主| 发表于 2014-9-4 17:06:48 | 显示全部楼层
csharp 发表于 2014-9-4 16:04
要定长、宽啊

对12*5,谢谢

点评

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

使用道具 举报

Free-Lancer
发表于 2014-9-4 17:50:11 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
ymcui2005 发表于 2014-9-4 17:06
对12*5,谢谢


给你个对话框的混合编程
  1. (defun c:tt (/ dcl fn id lst wid hig bp e pam pam1 p0 p1 p2 p3)
  2.   (setq        dcl '("temp:dialog {                      "
  3.               "    label = \"参数输入\" ;     "
  4.               "    :column {                  "
  5.               "        :edit_box {            "
  6.               "            key = \"wid\" ;    "
  7.               "            label = \"宽度\" ; "
  8.               "        }                      "
  9.               "        :edit_box {            "
  10.               "            key = \"hig\" ;    "
  11.               "            label = \"高度\" ; "
  12.               "        }                      "
  13.               "    }                          "
  14.               "    ok_only;                   "
  15.               "    errtile;                   "
  16.               "}                              "
  17.              )
  18.   )
  19.   (setq        fn (dcl:make dcl)
  20.         id (dcl:load fn "temp")
  21.   )

  23.   (action_tile "wid" "(dcl:checkin $value \"数字\" \"wid\")")
  24.   (action_tile "hig" "(dcl:checkin $value \"数字\" \"hig\")")
  25.   (action_tile
  26.     "accept"
  27.     "(setq lst (dcl:gettile '(\"wid\" \"hig\")))"
  28.   )
  29.   (dcl:start id fn)
  30.   (if (not (member "" lst))
  31.     (while (and        (setq e (entsel "\nPicks Corner of Pline: "))
  32.                 (= (cdr (assoc 0 (entget (car e)))) "LWPOLYLINE")
  33.            )
  34.       (setq bp         (cadr e)
  35.             e         (car e)
  36.             p0         (vlax-curve-getclosestpointto e bp)
  37.             pam         (vlax-curve-getparamatpoint e p0)
  38.             bp         (osnap bp "end")
  39.             pam1 (car
  40.                    (vl-remove (fix pam)
  41.                               (XD::Polyline:-Index+ e (fix (+ 0.5 pam)))
  42.                    )
  43.                  )
  44.             p1         (polar bp (angle bp p0) (distof (car lst)))
  45.             p2         (polar        bp
  46.                         (angle bp (vlax-curve-getpointatparam e pam1))
  47.                         (distof (cadr lst))
  48.                  )
  49.             p3         (polar p2 (angle bp p0) (distof (car lst)))
  50.       )
  51.       (pline:make (list bp p1 p3 p2) t)
  52.     )
  53.   )
  54.   (princ)
  55. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

csharp

已领礼包: 859个

财富等级: 财运亨通
发表于 2014-9-4 18:07:07 | 显示全部楼层
有一个地方不对，点到 起点 时，vl-remove 要再判断
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zxq0220

已领礼包: 9815个

财富等级: 富甲天下
发表于 2014-9-4 20:58:26 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 zxq0220 于 2014-9-5 21:05 编辑
  2. (defun c:tt ()
  3. (setvar "CMDECHO" 0)
  4. (while (and (setq s1 (entsel "\n选择矩形长边一点: "))
  5.          (setq ent (entget(car s1)))
  6.          (= (cdr(assoc 0 ent)) "LWPOLYLINE"))
  7. (setq ptlst (list))
  8. (foreach x ent (if (= (car x) 10) (setq ptlst (cons (cdr x) ptlst))))
  9. (setq ptlst (reverse ptlst))
  10. (setq p1 (osnap (cadr s1) "END"))
  11. (setq p2 (osnap (cadr s1) "NEAR"))
  12. (setq ang (angle p2 p1))
  13. (while (not(equal (distance p1 (car ptlst)) 0 1e-6))
  14.   (setq ptlst (append (cdr ptlst) (list(car ptlst))))
  15. )
  16. (setq ang1 (angle (caddr ptlst) p1))
  17. (if (or (> ang ang1) (and(equal ang 0 1e-6) (> ang1 pi)))
  18.   (setq p3 (polar (polar p1 (+ (/ pi 2) ang) 5) (+ pi ang) 12))
  19.   (setq p3 (polar (polar p1 (- ang (/ pi 2)) 5) (+ pi ang) 12))
  20. )
  21. (command "_.RECTANG" p1 p3)
  22. )
  23. (setvar "CMDECHO" 1)
  24. (princ)
  25. )

点评

ymcui2005
zxq0220 老大的程序简单对我比较实用， 现在还有一个问题是右下角红色框会跑出外面能否修改。谢谢 [attachimg]9689[/attachimg]  详情 回复 发表于 2014-9-5 08:58
Free-Lancer
惭愧，比你长多了  详情 回复 发表于 2014-9-4 22:45
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Free-Lancer
发表于 2014-9-4 22:45:34 | 显示全部楼层
zxq0220 发表于 2014-9-4 20:58

惭愧，比你长多了
  1. (if (not $rectang_wid)
  2.   (setq $rectang_wid 12.)
  3. )
  4. (if (not $rectang_hig)
  5.   (setq $rectang_hig 5)
  6. )
  7. (defun c:tt (/           dcl         fn    id    lst   wid         hig   bp    e
  8.              pam   pam1         p0    p1    p2           p3         pams  index bulges
  9.             )
  10.   (setq        dcl '("temp:dialog {                      "
  11.               "    label = \"参数输入\" ;     "
  12.               "    :column {                  "
  13.               "        :edit_box {            "
  14.               "            key = \"wid\" ;    "
  15.               "            label = \"宽度\" ; "
  16.               "        }                      "
  17.               "        :edit_box {            "
  18.               "            key = \"hig\" ;    "
  19.               "            label = \"高度\" ; "
  20.               "        }                      "
  21.               "    }                          "
  22.               "    ok_only;                   "
  23.               "    errtile;                   "
  24.               "}                              "
  25.              )
  26.   )
  27.   (setq        fn (dcl:make dcl)
  28.         id (dcl:load fn "temp")
  29.   )
  30.   (dcl:settile
  31.     '("wid" "hig")
  32.     (mapcar 'vl-princ-to-string
  33.             (list $rectang_wid $rectang_hig)
  34.     )
  35.   )
  36.   (action_tile "wid" "(dcl:checkin $value \"数字\" \"wid\")")
  37.   (action_tile "hig" "(dcl:checkin $value \"数字\" \"hig\")")
  38.   (action_tile
  39.     "accept"
  40.     "(setq lst (dcl:gettile '(\"wid\" \"hig\")))(done_dialog)"
  41.   )
  42.   (dcl:start id fn)
  43.   (if (not (member "" lst))
  44.     (progn
  45.       (mapcar 'set
  46.               '($rectang_wid $rectang_hig)
  47.               (mapcar 'distof lst)
  48.       )
  49.       (fy:begin)
  50.       (while
  51.         (and
  52.           (setq e (entsel "\n拾取多义线转角处: "))
  53.           (= (cdr (assoc 0 (entget (car e)))) "LWPOLYLINE")
  54.           (setq        bp    (cadr e)
  55.                 e     (car e)
  56.                 p0    (vlax-curve-getclosestpointto e bp)
  57.                 pam   (vlax-curve-getparamatpoint e p0)
  58.                 index (fix (+ 0.5 pam))
  59.                 bp    (vlax-curve-getpointatparam e index)
  60.           )
  61.           (or (vlax-curve-isclosed e)
  62.               (and (not (vlax-curve-isclosed e))
  63.                    (/= index (vlax-curve-getstartparam e))
  64.                    (/= index (vlax-curve-getendparam e))
  65.               )
  66.           )
  67.           (setq        bulges (mapcar 'cdr
  68.                                (vl-remove-if
  69.                                  '(lambda (x) (/= (car x) 42))
  70.                                  (entget e)
  71.                                )
  72.                        )
  73.           )
  74.           (setq        pams (PolyLine:-Index+
  75.                        e
  76.                        (if (and        (vlax-curve-isclosed e)
  77.                                 (= index (vlax-curve-getendparam e))
  78.                            )
  79.                          0
  80.                          index
  81.                        )
  82.                      )
  83.           )
  84.           (vl-every
  85.             'zerop
  86.             (mapcar '(lambda (x) (nth (fix x) bulges))
  87.                     (list (car pams)
  88.                           (if (zerop (cadr pams))
  89.                             0
  90.                             (1- (cadr pams))
  91.                           )
  92.                     )
  93.             )
  94.           )
  95.         )
  96.          (if (and (= index (vlax-curve-getendparam e))
  97.                   (> pam 1)
  98.              )
  99.            (setq pam1 1.0)
  100.            (if (< (car pams) pam index)
  101.              (setq pam1 (cadr pams))
  102.              (setq pam1 (car pams))
  103.            )
  104.          )
  105.          (setq p1 (polar bp (angle bp p0) (distof (car lst)))
  106.                p2 (polar bp
  107.                          (angle bp (vlax-curve-getpointatparam e pam1))
  108.                          (distof (cadr lst))
  109.                   )
  110.                p3 (polar p2 (angle bp p0) (distof (car lst)))
  111.          )
  112.          (pline:make (list bp p1 p3 p2) t)
  113.       )
  114.       (fy:end)
  115.     )
  116.   )
  117.   (princ)
  118. )
  119. (defun PolyLine:-Index+        (e index / nNums)
  120.   (setq nNums (cdr (assoc 90 (entget e))))
  121.   (cond
  122.     ((<= index 0)
  123.      (list (1- nNums) 1)
  124.     )
  125.     ((>= index (1- nNums))
  126.      (list (- nNums 2) 0)
  127.     )
  128.     (t
  129.      (list (1- index) (1+ index))
  130.     )
  131.   )
  132. )
555.gif
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

newer

已领礼包: 40个

财富等级: 招财进宝
发表于 2014-9-4 22:55:11 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 newer 于 2014-9-4 23:04 编辑

来个API 版本的，主要是用向量判断方向，保存默认值的。

xdtb_rectang.gif

  1. (defun c:t1 ()  (if (setq e (xdrx_entsel "\n拾取多段线确定矩形位置<退出>:" '((0 . "LWPOLYLINE"))))
  2.     (progn
  3.       (setq pt (xdrx_curve_getClosestPoint (car e) (cadr e))
  4.             e (car e)
  5.             inx (XD::Polyline:NearIndex e pt)
  6.             inxl (XD::Polyline:-Index+ e inx)
  7.             currentPt (XD::Pnt:SetZ (xdrx_getpropertyvalue e "PointAt" inx) 0.0)
  8.             nextPt (XD::Pnt:SetZ (xdrx_getpropertyvalue e "PointAt" (car inxl)) 0.0)
  9.             prevPt (XD::Pnt:SetZ (xdrx_getpropertyvalue e "PointAt" (cadr inxl)) 0.0)
  10.             nVec (xdrx_vector_normalize (mapcar '- nextPt currentPt))            
  11.             pVec (xdrx_vector_normalize (mapcar '- prevPt currentPt ))
  12.       )
  13.       (if (xdrx_vector_IsPerpendicular nVec pVec)
  14.          (progn
  15.              (if (not $XDTB_GLOBAL_VAR_WIDTH)
  16.                 (setq $XDTB_GLOBAL_VAR_WIDTH 100)
  17.              )
  18.              (if (setq w (getreal (strcat "\n矩形长<" (rtos $XDTB_GLOBAL_VAR_WIDTH 2 2) ">:")))
  19.                 (setq $XDTB_GLOBAL_VAR_WIDTH w)
  20.              )
  21.              (if (not $XDTB_GLOBAL_VAR_HEIGHT)
  22.                 (setq $XDTB_GLOBAL_VAR_HEIGHT 100)
  23.              )
  24.              (if (setq h (getreal (strcat "\n矩形宽<" (rtos $XDTB_GLOBAL_VAR_HEIGHT 2 2) ">:")))
  25.                 (setq $XDTB_GLOBAL_VAR_HEIGHT h)
  26.              )
  27.              (setq hVec (xdrx_vector_Product pVec $XDTB_GLOBAL_VAR_WIDTH)
  28.                    wVec (xdrx_vector_Product nVec $XDTB_GLOBAL_VAR_HEIGHT)
  29.                    Vec (mapcar '+ hVec wVec)
  30.                    p1 currentPt
  31.                    p2 (mapcar '+ currentPt wVec)
  32.                    p3 (mapcar '+ currentPt Vec)
  33.                    p4 (mapcar '+ currentPt hVec)
  34.              )
  35.              (XD::Polyline:Make (list p1 p2 p3 p4) t)
  36.          )
  37.       )
  38.     )
  39.   )
  40.   (princ)
  41. )

点评

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-28 11:41 , Processed in 0.303948 second(s), 60 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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