[LISP程序]：鼠标拖动序号球

lsjjm

鼠标拖动序号球
[php]
for Line-Circle-Text
(defun c:test ( / ss p1 p2 le ce te)
  (setq loop t)
  (setq ss (ssget))
  (setq n 0)
  (while (< n (sslength ss))
    (cond
      ((= (cdr (assoc 0 (entget (ssname ss n)))) "LINE")(setq ll (ssname ss n)))
      ((= (cdr (assoc 0 (entget (ssname ss n)))) "CIRCLE")(setq cc (ssname ss n)))
      ((= (cdr (assoc 0 (entget (ssname ss n)))) "TEXT")(setq tt (ssname ss n)))
    )
    (setq n (1+ n))
  )
  (setq le (entget ll)
        p1 (cdr (assoc 10 le))
        p2 (cdr (assoc 11 le))
        ce (entget cc)
        te (entget tt))
  (while loop
    (setq p (grread T))
    (if (= (car p) 3)(setq loop nil))
    (setq x1 (car (cadr p)))
    (setq y1 (cadr (cadr p)))
    (setq ce (subst (list 10 x1 y1)(assoc 10 ce) ce))
    (entmod ce)
    (setq te (subst (list 11 x1 y1)(assoc 11 te) te))
    (entmod te)
    (setq ce (entget cc)
          pc (cdr (assoc 10 ce))
           r (cdr (assoc 40 ce)))
    (if (equal (distance p1 pc) r 0.001)
      (setq p1 (polar pc (angle pc p2) r)
            le (subst (list 10 (car p1)(cadr p1))(assoc 10 le) le))
      (setq p2 (polar pc (angle pc p1) r)
            le (subst (list 11 (car p2)(cadr p2))(assoc 11 le) le))
    )
    (entmod le)
  )
  (princ)
)
[/php]

陌生人

没有演示，提示不明确，不知道怎么用：（

xgwl

只要有个圆,还有一根线和他相交,程序就能运行,但不明白这个程序在哪能用上!?

陌生人

圆圈内有文字的时候，文字不跟着跑？
那序号球，什么样的才算序号球？做了块也不行。
序号两个字还是去掉吧，要不再完善一下？

lsjjm

2..4楼: 对不起, 我不能输入中文, 这些都是剪切的. 有些话说不清楚. 再说你都是长老了, 还用说明吗, 我都不如你呀!
3楼: 这个程序是应一个网友编的,只是基本功能, 但经过测试, 圆圈, 数字,直线都能一起拖动,  能说说你执行后的具体情况吗?

自由的鱼

这个程序的功能以前还谁申请过，忘了~~,:(

陌生人

最初由 lsjjm 发布
[B]2..4楼: 对不起, 我不能输入中文, 这些都是剪切的. 有些话说不清楚. 再说你都是长老了, 还用说明吗, 我都不如你呀!
3楼: 这个程序是应一个网友编的,只是基本功能, 但经过测试, 圆圈, 数字,直线都能一起拖动,  能说?.. [/B]

长老过谦了。上次因为忙，也没时间看程序，就只是测试。
原因找到了。
(setq te (subst (list 11 x1 y1)(assoc 11 te) te))
    (entmod te)
对text应该改dxf10。如下：
(setq te (subst (list 10 x1 y1)(assoc 10 te) te))
    (entmod te)

aidraft

长老过谦了。上次因为忙，也没时间看程序，就只是测试。
原因找到了。
(setq te (subst (list 11 x1 y1)(assoc 11 te) te))
(entmod te)
对text应该改dxf10。如下：
(setq te (subst (list 10 x1 y1)(assoc 10 te) te))
(entmod te) [/COLOR]

其实程序没问题，DXF码11也没问题，但TEXT的对齐方式可能应为MC

陌生人

你说的对，当文字对齐方式是mc的时候，dxf11是可以的。
不过最好在程序中有个说明or提示什么的

lsjjm

1. 序号球中的数字对齐方式基点都是"MC" . (90%?)
2. 抱歉. 由于条件关系, 我贴的程序很少详细说明, 更不用说演示了. 因此得分也少---
  hehe,  JUST KIDDING!

aeo

最初由 lsjjm 发布
[B]1. 序号球中的数字对齐方式基点都是"MC" . (90%?)
2. 抱歉. 由于条件关系, 我贴的程序很少详细说明, 更不用说演示了. 因此得分也少---
  hehe,  JUST KIDDING! [/B]

hehe

实用性实在差了些.

用grread, 还不如用鼠标：夹点，按住左键一拽. R2005,还可以右键拽（copy）


如果写教程，那必要的注解总要的.

lsjjm

最初由 aeo 发布
[B]...hehe 实用性实在差了些.
用grread, 还不如用鼠标：夹点，按住左键一拽. R2005,还可以右键拽（copy）如果写教程，那必要的注解总要的... [/B]

我说过的, 这个程序是应一个网友编的,只是基本功能. 至于实用不实用, 一个人有一个人的见解. 斑竹何不写一个实用性不差的呢?

yfywk

你的程序虽然好，但就是实用性差，
用最简的cad命令都能轻松实现的dd，我想没必要编程去实现吧！