fire9527 发表于 2015-4-3 22:34:31

求大神帮写一个调整leader角度的程序，万分感激！

本帖最后由 fire9527 于 2015-5-30 18:01 编辑

想要实现的功能如截图和上传的测试图中所述，
个人感觉“初步诉求”就够用了，后面两个只是更完善罢了，如果很难可以忽略，
这帖子立了很长时间了，先后得到 ZZXXQQ、xyp1964、vectra三位大神的热情相助（衷心感谢你们！），演示效果很好，但是很遗憾，本人编程小白，在自己电脑上用就是不行
ZZXXQQ帮在下写的程序，CAD提示：; 错误: 参数太少
xyp1964帮在下写的程序，只是向右平移的效果，没有院长本人演示的效果
vectra的提示在下照做了，还是没有效果

这个问题也许在你们看来已经解决了，但是在下实在是捣鼓不明白，为体现诚意，特意提高悬赏，还希望你们好人做到底，送佛送到西，让小弟把这件宝贝带到工作中，再次叩谢！

danxingpen 发表于 2015-4-3 22:34:32

本帖最后由 danxingpen 于 2015-5-31 17:31 编辑


(defun c:tt ()
(if (setq ss (ssget '((0 . "LEADER"))))
(repeat (setq i (sslength ss))
   (setq ent (entget(ssname ss (setq i (1- i)))))
   (setq ptx (cadr(assoc 10 ent)))
   (setqa 0
    n(length ent)
    )
    (foreach x ent
      (if (= (car x) 10)
(progn
    (setq a(1+ a))
    (if (= a 2)
      (setq movex (- ptx (cadr x)))
    )
)
      )
    )
   (setq mtext(cdr(assoc '340 ent)))
   (setq mtext(entget mtext))
   (setq mtext(subst (cons 10 (mapcar '+ (cdr (assoc '10 mtext))(list movex 0 0)))
          (assoc '10 mtext)
          mtext
          ))
    (entmod mtext)
)
)
(princ)
);在ZZXXQQ的基础上改了一下,你这个引线带编组的,主驱动是mtext,,,所以,,,,他们的都移动不了

fire9527 发表于 2015-4-5 20:52:19

自己默默的顶起来

ZZXXQQ 发表于 2015-4-6 10:40:04

本帖最后由 ZZXXQQ 于 2015-5-31 08:54 编辑

;引线规整 明经 ZZXXQQ 2015.4.6 2015.5.31
(defun c:tt ()
(if (setq ss (ssget '((0 . "LEADER"))))
(repeat (setq i (sslength ss))
   (setq ent (entget(ssname ss (setq i (1- i)))))
   (setq ptx (cadr(assoc 10 ent)))
   (setq ent1 (list) a T)
   (foreach x ent
    (if (/= (car x) 10)
   (setq ent1 (cons x ent1))
   (if (equal (cadr x) ptx 1e-6)
      (setq ent1 (cons x ent1))
      (if a (setq ent1 (cons (list (car x) ptx (caddr x) (last x)) ent1) a nil)
       (setq ent1 (cons x ent1))
      )
   )
    )
   )
   (entmod (reverse ent1))
)
)
(princ)
)

xyp1964 发表于 2015-4-6 13:58:01

;; xyp-LeaderR 引线实体归正 (xyp-LeaderR 引线实体)
(defun xyp-LeaderR (s1 / ptn lst s2 p1 p2 p3)
(setq ptn (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget s1))
      ptn (mapcar 'cdr ptn)
      lst (vl-remove-if-not '(lambda (x) (= (car x) 330)) (entget s1))
      lst (mapcar 'cdr lst)
      s2(car lst)
      lst (vl-remove-if-not '(lambda (x) (= (car x) 340)) (entget s2))
      s2(last (mapcar 'cdr lst))
      p1(car ptn)
      p2(cadr ptn)
      p3(inters p1 (polar p1 (* pi 0.5) 10) p2 (polar p2 0 10) nil)
)
(command "move" s2 "" "non" p2 "non" p3)
)

;; tt(引线归正)
(defun c:tt ()
(setq i -1)
(if (setq ss (ssget '((0 . "leader"))))
    (while (setq s1 (ssname ss (setq i (1+ i))))
      (xyp-LeaderR s1)
    )
)
(princ)
)

xyp1964 发表于 2015-4-6 15:16:50


fire9527 发表于 2015-4-19 14:02:15

ZZXXQQ 发表于 2015-4-6 10:40 static/image/common/back.gif


龙版主，您的程序有这个提示：
选择对象:
; 错误: 参数太少

fire9527 发表于 2015-4-19 14:05:16

xyp1964 发表于 2015-4-6 13:58 static/image/common/back.gif


院长，怎么实现不了您演示的效果了？我试了，只是向右平移而已，您的工具箱也是加载了的

vectra 发表于 2015-4-19 18:46:41

把院长的xyp-LeaderR函数修改为下面的代码就可以了

(defun xyp-LeaderR (s1 / ptn lst s2 p1 p2 p3)
(setq        ptn (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget s1))
        ptn (mapcar 'cdr ptn)
        lst (vl-remove-if-not '(lambda (x) (= (car x) 340)) (entget s1))
        lst (mapcar 'cdr lst)
        s2(car lst)
        p1(car ptn)
        p2(cadr ptn)
        p3(list (car p1) (cadr p2) 0)
)
(command "move" s2 "" "non" p2 "non" p3)
)

fire9527 发表于 2015-4-24 10:25:40

xyp1964 发表于 2015-4-6 15:16 static/image/common/back.gif


院长，怎么只是移动呢？很需要这个功能，万望回复
页: [1] 2
查看完整版本: 求大神帮写一个调整leader角度的程序，万分感激！