求：圈动链带 线、文字动

freehand8008

看到小同事在做这个，一个个的挪挺附近的，所有才求助

结果：红线外侧四点始终不动，动绿圈，其他联动 。

希望 ：白色文字平行于对应红线、红线内侧四点跟圈有交点、圈里面字居中）




我试过了CAD里面的约束，一个个设置很麻烦，而且根本达不到想要的结果。
希望哪位高人在闲暇之于帮忙给整整。
万分感谢......ing
(每天登录、积极顶帖，）

hao3ren

为啥不做成组和块啊

freehand8008

hao3ren 发表于 2014-6-12 23:40
为啥不做成组和块啊

以为需要调整的太多了，做不过来

edata

算是第一步，没时间弄。。残品。
--------------------------------------------------------------------------------

freehand8008

edata 发表于 2014-6-27 15:17
算是第一步，没时间弄。。残品。
-------------------------------------------------------------------- ...

是否感谢期待中！！！

langjs

;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
;;; 移动程序    by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:tt ( / code d data ent ent1 entc enttx gr i inf loop lst n nent pt pt1 pt2 pt3 ptlst r ss ss1 x)
  (defun *error* (inf)
    (setq inf (strcase inf t))
    (cond
      ((wcmatch inf "*break*,*cancel*,*exit*,*取消*,*中断*")
        (princ "\n用户按了<Esc>强制退出\n")))
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (princ))
  (defun reent (ent ptlst / i nent x)  
    (setq i -1          nent '())
    (foreach x ent
      (setq nent (append   nent
         (list (if (and (= (car x) 10) (/= (nth (setq i (1+ i)) ptlst  ) nil ))
                           (cons 10 (nth i ptlst))  x ))))))
  (defun emod (ent i n)                     
    (subst  (cons i n) (assoc i ent)  ent ))
  (setvar "cmdecho" 0)
  (setq ent (car (entsel "\n选择圆:")))
  (if (= (cdr (assoc 0 (setq ent (entget ent)))) "CIRCLE")
    (progn
      (setq pt (cdr (assoc 10 ent))  r (cdr (assoc 40 ent))lst '() i 0 )
      (repeat 359 (setq lst (cons (* (/ i 180.0) pi) lst) i (1+ i)))
      (setq lst (mapcar '(lambda (i)  (polar pt i (+ r 1))) lst))))
  (setq entc ent)
  (setq ss (ssget "F" (list (polar pt 0.0 r) (polar pt pi r)) '((0 . "TEXT"))))
  (setq enttx (entget (ssname ss 0)))
  (setq ss (ssget "CP" lst '((0 . "TEXT,CIRCLE,LWPOLYLINE")))lst '())
  (repeat (setq i (sslength ss))
    (setq ent (entget (ssname ss (setq i (1- i)))))
    (if (= (cdr (assoc 0 ent)) "LWPOLYLINE")
      (progn
        (if (< (distance pt (setq pt1 (cdr (assoc 10 ent)))) (distance pt (setq pt2 (cdr (assoc 10 (reverse ent))))))
          (setq pt1 pt2))
        (setq d (angle pt pt1) pt2 (polar pt d r) pt3 (polar pt d (* 0.5 (+ (distance pt pt1) (distance pt pt2)))))
        (if (or (< d (* 0.5 pi)) (> d (* 1.5 pi)))
          (setq pt3 (polar pt3 (- d (* 0.5 pi)) 200.0))
          (setq pt3 (polar pt3 (+ d (* 0.5 pi)) 200.0))        )
        (if (setq ss1 (ssget "F" (list (polar pt3 d 300) (polar pt3 (+ pi d) 300)) '((0 . "TEXT"))))
          (setq ent1 (entget (ssname ss1 0))lst (cons (list pt1 ent ent1) lst))))))
  (princ "\n指定位置:")
  (setq loop t)
  (while loop
    (progn
      (setq gr (grread t 15 0)  code (car gr)  data (cadr gr))
      (cond((= code 3) (setq loop nil))
        ((= code 5)                     
          (setq pt data)
          (foreach i lst
            (setq pt1 (car i)  ent (cadr i) ent1 (caddr i) d (angle pt pt1)  pt2 (polar pt d r)
                  ent (reent ent (list pt1 pt2)))
            (entmod ent)
            (setq pt3 (polar pt d (* 0.5 (+ (distance pt pt1) (distance pt pt2)))))
            (if (or  (< d (* 0.5 pi)) (> d (* 1.5 pi))        )
              (setq pt3 (polar pt3 (- d (* 0.5 pi)) 100.0))
              (setq pt3 (polar pt3 (+ d (* 0.5 pi)) 100.0)  d (+ d pi)))
            (setq ent1 (emod ent1 10 pt3) ent1 (emod ent1 11 pt3) ent1 (emod ent1 50 d)
                  entc (emod entc 10 pt)  enttx (emod enttx 10 pt) enttx (emod enttx 11 pt))
            (entmod ent1) (entmod entc) (entmod enttx)))
        ((or(= code 11) (= code 25))
          (setq loop nil))
        (t)
      )  t  ))
(princ)
)

langjs

貌似理解错意思了，光联动还少了个移出功能。怎么个移法不甚明白

freehand8008

langjs 发表于 2014-6-30 12:55
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
;;; 移动程序    by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝ ...

很是感激！！！感激！！！感激！！！

测试了，的的确确很完美。

有2个小小的提议：  1，能否加个F8或者捕捉   最需的是 Y向移动，X无所谓（我按了几次F3\F8都未遂）     2 ， 能否批量选择（批量是提高生产力的核心）

其他均无！

风树

langjs 发表于 2014-6-30 12:55
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
;;; 移动程序    by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝ ...

好家伙！                          

langjs

freehand8008 发表于 2014-6-30 17:05
很是感激！！！感激！！！感激！！！

测试了，的的确确很完美。

能加个F8沿Y轴移动。至于捕捉和批量，编程太复杂了还是算了吧