明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1146|回复: 5

大家谁帮着写一个把带圈数字移动到最近端点的lisp

[复制链接]
发表于 2016-6-7 08:51 | 显示全部楼层 |阅读模式
如题,大家谁帮着写一个把带圈数字移动到最近端点的lisp。

本帖子中包含更多资源

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

x
发表于 2016-6-8 12:00 | 显示全部楼层
首先,想对楼主说一句话,起码的谢谢要有吧,谁也不欠你的....
其次呢,你应该说明你的对象是 带圆的文字 还是块  还有就是那个是直线还是多段线...
正确的描述才能得到所需的帮助!
发表于 2016-6-8 18:33 | 显示全部楼层
  1. (defun c:tt (/);靠近圆和圆内文字移动到两线没有相交的端点
  2.   (prompt "选择图形")
  3.   (setq app nil)
  4.   (setq ss (ssget))
  5.   (command "select" ss "")
  6.   (setq ss-line (ssget "p" '((0 . "*LINE"))))
  7.   (setq na-1 (ssname ss-line 0))
  8.   (setq pta (vlax-curve-getstartpoint na-1))
  9.   (setq ptb (vlax-curve-getendpoint na-1))
  10.   (setq na-2 (ssname ss-line 1))
  11.   (setq ptaa (vlax-curve-getstartpoint na-2))
  12.   (setq ptbb (vlax-curve-getendpoint na-2))
  13.   (if (equal pta ptaa 5)
  14.     (setq lis (list ptb ptbb))
  15.     (progn
  16.       (if (equal pta ptbb 5)
  17.         (setq lis (list ptb ptaa))
  18.         (progn
  19.           (if (equal ptb ptaa 5)
  20.             nil
  21.             (setq lis (list pta ptaa))
  22.           )
  23.         )
  24.       )
  25.     )
  26.   )
  27.   (setq        lis (vl-sort lis
  28.                      (function (lambda (e1 e2)
  29.                                  (< (car e1) (car e2))
  30.                                )
  31.                      )
  32.             )
  33.   )
  34.   (command "select" ss "")
  35.   (setq ss-CIRCLE (ssget "p" '((0 . "CIRCLE"))))
  36.   (setq ii 0)
  37.   (repeat (sslength ss-CIRCLE)
  38.     (setq name (ssname ss-CIRCLE ii)
  39.           ii   (1+ ii)
  40.           cen  (cdr (assoc 40 (entget name)))
  41.     )
  42.     (setq app (append (list (append (list cen) (list name))) app))
  43.   )
  44.   (setq        app (vl-sort app
  45.                      (function (lambda (e1 e2)
  46.                                  (< (car e1) (car e2))
  47.                                )
  48.                      )
  49.             )
  50.   )
  51.   (mapcar '(lambda (x y)
  52.              (vl-cmdf "move"
  53.                       (sss (cadr y))
  54.                       ""
  55.                       (cdr (assoc 10 (entget (cadr y))))
  56.                       x
  57.              )
  58.            )
  59.           lis
  60.           app
  61.   )
  62. )
  63. (defun sss (na / cen en pt- pt+ pt< pt> rad ss)
  64.   (setq en (entget na))
  65.   (setq rad (cdr (assoc 40 en)))
  66.   (setq cen (cdr (assoc 10 en)))
  67.   (setq pt> (polar cen 0 (1+ rad)))
  68.   (setq pt< (polar cen pi (1+ rad)))
  69.   (setq pt+ (polar cen (* 0.5 pi) (1+ rad)))
  70.   (setq pt- (polar cen (* 1.5 pi) (1+ rad)))
  71.   (setq ss (ssget "cp" (list pt> pt+ pt< pt-)))
  72. )
 楼主| 发表于 2016-6-12 08:56 | 显示全部楼层
哦,谢谢楼上各位,谢谢434939575兄帮忙。
 楼主| 发表于 2016-6-12 09:03 | 显示全部楼层
分别为圆和数字,线是L线,谢谢cdma2546兄。
发表于 2020-6-17 07:23 | 显示全部楼层
测试了上面老师的程序,加载后,输入命令,不能运行。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 04:53 , Processed in 0.404072 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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