szxgsh 发表于 2013-6-18 12:00:34

求引注线（LEADER）平行源码！……如果比较难写，可以付点辛苦费(^_^)

本帖最后由 szxgsh 于 2013-6-22 14:53 编辑

是否要判断这条引线是否是折型的，就是转弯的那种？
如果不用判断，就选择一条母线，去刷其他的。一定是只能调整中间那个折弯位置那个点，其他2个点是不能动的（就是引出位置点，和文字接入点）。
就高手赐教源码！


如果比较难写，可以适当支付辛苦费。有意者可以给我留言。

danxingpen 发表于 2013-8-11 10:35:41

(defun LeadParallel(/standlead ent plist p1 p2 v12 leadsels n rlist p1 p2 p3 rightp2 )
(setq standlead(car(entsel "\n选择作为标准的引线标注:")))
(setq ent(entget standlead))
(setq plist nil)
(foreach x ent
    (if (= 10 (car x))
      (setq plist(cons (cdr x) plist))
    )
)
(setq plist(reverse plist))
(setq p1(car plist)
p2(cadr plist))
(setq v12(mapcar '- p2 p1))
(setq leadsels(ssget (list '(0 . "LEADER"))))
(repeat (setq n(sslength leadsels))   
    (setq ent(entget(ssname leadsels (setq n(1- n)))))
    (setq plist nil)
    (setq rlist nil)
    (foreach x ent
      (if (= 10 (car x))
(setq plist(cons (cdr x) plist))
(setq rlist (cons x rlist))
)
      )
    (setq rlist(reverse rlist))
    (setq plist(reverse plist))
    (setq p1(car plist)
   p2(cadr plist)
   p3(caddr plist))
    (setq rightp2(inters p1 (mapcar '+ p1 v12) p2 p3 nil))
    (if rightp2
      (progn
(setq rlist(append rlist (list (cons 10 p1))))
(setq rlist(append rlist (list (cons 10 rightp2))))
(setq rlist(append rlist (list (cons 10 p3))))
(entmod rlist)
      )
    )
)
(princ)
)
;纯粹操作,,没有出错处理!

qq1254582201 发表于 2017-11-29 20:55:51

ZZXXQQ 发表于 2013-8-11 11:03


非常给力啊

szxgsh 发表于 2013-6-18 20:03:54

莫非我这个需求很多人用不到么？没高手出手……

szxgsh 发表于 2013-6-21 10:43:54

期待高手！

szxgsh 发表于 2013-6-22 14:53:58

如果比较难写，可以适当支付辛苦费。有意者可以给我留言。

szxgsh 发表于 2013-8-10 21:36:36

高手尚未关注，再顶一下！

wowan1314 发表于 2013-8-10 21:41:29

去任务大厅发布。 估计马上就会有人给写了

wowan1314 发表于 2013-8-10 22:08:01

本帖最后由 wowan1314 于 2013-8-10 22:15 编辑

另外据我分析： 楼主现在发布任务的话。会很占便宜。

因为任务大厅才建设好。作为第一个发布任务的人。
版主们肯定不会让他空手而归。会第一时间不计代价的满足你的要求。

是个花少量代价，得大量好处的机会！ 注意把握。。

ZZXXQQ 发表于 2013-8-11 11:03:21

;统一引线斜度 明经 ZZXXQQ 2013.8.11
(defun c:tt ()
(if (and (setq s1 (entsel "\n选择引线:"))
          (setq ent (entget(car s1)))
          (= (cdr(assoc 0 ent)) "LEADER")) (progn
(setq plst (list))
(redraw (car s1) 3)
(foreach x ent (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
(setq ang (angle (last plst) (cadr plst)))
(if (setq ss (ssget '((0 . "LEADER")))) (progn
   (setq i -1)
   (repeat (sslength ss)
    (setq en (ssname ss (setq i (1+ i)))
          ent (entget en)
          nent (list))
    (repeat 20 (setq nent (append nent (list(car ent))) ent (cdr ent)))
    (setq p1 (cdr(last nent)) p2 (cdar ent) p3 (cdadr ent))
    (if (setq p4 (inters p1 (polar p1 ang 20) p2 p3 nil)) (progn
   (setq nent (append nent (list(cons 10 p4))) ent (cdr ent))
   (foreach x ent (setq nent (append nent (list x))))
   (entmod nent)
    ))
   )
))
        (redraw (car s1) 4)
))
(princ)
)

chendili 发表于 2013-8-15 11:24:14

楼上的测试了，好用，要是能加上框选就好了
页: [1] 2 3
查看完整版本: 求引注线（LEADER）平行源码！……如果比较难写，可以付点辛苦费(^_^)