明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 5726|回复: 27

求【自动选取角点画出直线工具】!`~

  [复制链接]
发表于 2011-7-13 15:06:37 | 显示全部楼层 |阅读模式
本帖最后由 daidong013 于 2011-7-13 15:14 编辑

求这样的工具!~~引线长度可以随自己拉!~

本帖子中包含更多资源

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

x
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2011-7-13 20:54:11 | 显示全部楼层
本帖最后由 zhynt 于 2011-7-14 09:23 编辑

  1. ;;判断点是否在方框内
  2. (defun point_inm (pt pt1 pt2 pt3 pt4 / dist1 dist2 dist3 dist4 pt pt1
  3.                   pt2 pr3 pt4)
  4.   (setq        dist1 (point_line pt pt1 pt2)
  5.         dist2 (point_line pt pt2 pt3)
  6.         dist3 (point_line pt pt1 pt4)
  7.         dist4 (point_line pt pt3 pt4)
  8.   )
  9.   (if (equal (+ dist1 dist2 dist3 dist4)
  10.              (+ (distance pt1 pt2) (distance pt2 pt3))
  11.              1e-10
  12.       )
  13.     t
  14.     nil
  15.   )
  16. )
  17. ;;点到直线的垂直距离
  18. (defun point_line (pt pt1 pt2 / ptangle ptn pt pt1 pt2 dist jptx)
  19.   (setq        ptangle        (angle pt1 pt2)
  20.         ptn        (polar pt (+ (* 0.5 pi) ptangle) 0.01)
  21.         jptx        (inters pt ptn pt1 pt2 nil)
  22.         dist        (distance pt jptx)
  23.   )
  24.   dist
  25. )
  26. ;;将点表中在方框内的点组成新表
  27. (defun pt_inm (oldlst PT1 PT2 PT3 PT4 /        oldlist        n pt1 pt2 pt3 pt4
  28.                templst newlst)
  29.   (setq templst '())
  30.   (foreach n oldlst
  31.     (if        (/= (point_inm n pt1 pt2 pt3 pt4) nil)
  32.       (setq templst (cons n templst))
  33.     )
  34.   )
  35.   (setq newlst (reverse templst))
  36. )
  37. ;;多段线顶点表
  38. (defun pt_list (ent)
  39.   (mapcar 'cdr
  40.           (vl-remove-if '(lambda (x) (/= 10 (car x))) ent)
  41.   )
  42. )
  43. ;;;去除 y 坐标相同的,并从上到下排序
  44. (defun y_lst (lst rc / it lst2)
  45.   (setq lst2 '())
  46.   (setq lst (vl-sort lst (function (lambda (e1 e2) (> (car e1)  (car e2))))))
  47.   (while (setq lst2 (cons (setq it (car lst)) lst2)
  48.                lst  (vl-remove-if
  49.                       '(lambda (x) (equal (cadr it) (cadr x) rc))
  50.                       lst
  51.                     )
  52.          )
  53.   )
  54.   lst2
  55. )
  56. (defun c:yl (/ pta ptb ptax ptay ptbx ptby ptaxby pybxay se pt_lst n m pta pt )
  57.   (setq pta (getpoint "\n框选第一点:"))
  58.   (setq ptb (getcorner pta "\n框选第二点:"))
  59.   (if (/= ptb nil)
  60.     (progn (setq ptax (car pta)
  61.                  ptay (cadr pta)
  62.                  ptbx (car ptb)
  63.                  ptby (cadr ptb)
  64.            )
  65.            (setq ptaxby        (list ptax ptby)
  66.                  ptbxay        (list ptbx ptay)
  67.            )           
  68.            (setq se (ssget "c" pta ptb '((0 . "LWPOLYLINE"))))
  69.     )
  70.   )
  71.   (setq pt_lst (pt_list (entget (ssname se 0))))
  72.   (setq pt_lst (pt_inm pt_lst pta ptaxby ptb ptbxay))

  73.   (setq pt_lst (y_lst pt_lst 1e-5))
  74.   (setq        n (length pt_lst)
  75.         m 0
  76.   )
  77.   (setq pta (getpoint "\n位置:"))
  78.   (while (/= m n)
  79.     (setq pt (nth m pt_lst))
  80.     (command "_.line" "NON" pt "NON"(polar pt 0 (- (car pta)(car pt))) "")
  81.     (setq m (1+ m))
  82.   )
  83. )

评分

参与人数 4金钱 +100 收起 理由
hhh454 + 10 很给力!
yoyoho + 20 实用程序
gcho + 20 工具不错,zhynt费心了!
daidong013 + 50 非常好的工具!~~

查看全部评分

回复 支持 1 反对 0

使用道具 举报

 楼主| 发表于 2011-7-13 16:18:42 | 显示全部楼层
坐个沙发!~~这个功能有点类似QDIM的效果!~~~
发表于 2011-7-13 20:54:19 | 显示全部楼层
本帖最后由 mgame168 于 2011-7-13 20:56 编辑

用來當輔助線工具, 應該很方便
发表于 2011-7-13 22:08:55 | 显示全部楼层
回复 zhynt 的帖子

我载入测试的时候提示语法错误...
发表于 2011-7-13 23:07:13 | 显示全部楼层
板凳

是雷锋吧~~~
 楼主| 发表于 2011-7-14 09:20:41 | 显示全部楼层
回复 zhynt 的帖子

zhynt大侠:好像提示语法错误!~~加载上了没用!~~
发表于 2011-7-14 09:23:46 | 显示全部楼层
回复 daidong013 的帖子

已经改好了。
 楼主| 发表于 2011-7-14 09:28:59 | 显示全部楼层
回复 zhynt 的帖子

可以了!~~就是这样的效果!~~~
发表于 2011-7-14 09:47:00 | 显示全部楼层
daidong013的思路很好,这种快速布置辅助线的思路对我也有用,另外zhynt是传说中的高手,佩服
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-7-26 07:51 , Processed in 0.190679 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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