求大师弄个可批量平行线的中心线谢谢
要求：平行线的中线线。批量生成
要生成中心线的层由在图纸中指定。。。
命令：提示要生成中线的平行线间距[这个手工设置]，
如输入400就是说平行线间距在400及以内的平线线可生行中心线，
不在指定范围以内的就不可以生成
效果图如下：麻烦了谢谢
如果就象测试图那种情况的话，凭着1万1千的积分怎么也能自己搞定了吧 本帖最后由 品茗新秀 于 2014-3-30 12:01 编辑
我抄的哪位高手的，楼主看看，是否有用
(defun c:tt( /dist e1 e2 ent1 ent2 m1 pt1 pt2 ssl)
(setq ssL (ss->LST (ssget '((0 . "LINE")))));选择直线
(while (setqent1 (car ssl));第一个图元名
(setq pt1 (cdr (assoc 10 (entget ent1))));得第一个图元的起点坐标
(setq pt2 (cdr (assoc 11 (entget ent1))));得第一个图元的终点坐标
(setq m1 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt1 pt2))
(setq ssl (cdr ssl));余下直线图元
(setq dist(function (lambda (e1 e2) (> (distancem1 (vlax-curve-getClosestPointTo e1m1)) (distancem1 (vlax-curve-getClosestPointTo e2m1)) ))))
(setq ent2 (last (vl-sort ssl dist)))
(setq ssl (vl-remove ent2 ssl))
(center-lineent1 ent2 )
)
(princ)
)
;vlax-curve-getClosestPointTo 对象(即图元)寻找曲线上距该点最近的点
; (vl-sort '((1 3) (2 2) (3 1))
; (function (lambda (e1 e2)
; (< (cadr e1) (cadr e2)) ) ) )
;返回((3 1) (2 2) (1 3))
;last + list
;返回表的最后一个元素
;vl-remove +要删除的元素的值 +任意表
;删除表中的元素
;(setq ssl (vl-remove ent2 ssl)) 为重点，得最近的一个图元
;选择集循环
(defun ss->LST ( ss / i l )
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (ssname ss (setq i (1- i))) l))
)
)
)
;得中点坐标，绘制中点线
(defun center-line (x1 x2 /angdd dd1 en m0 m1 m2pt1 pt10-1 pt11-1 pt2 pt3 pt4 str)
(setq pt1 (cdr (assoc 10 (entget x1)))
pt2 (cdr (assoc 11 (entget x1)))
pt3 (cdr (assoc 10 (entget x2)))
pt4 (cdr (assoc 11 (entget x2)))
(if (inters pt1 pt4 pt2 pt3)
(if (and(<= (distance pt1 pt3) 600)(> (distance pt1 pt3) 100))
(progn (setq m1 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt1 pt3)
m2 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt2 pt4))
))
(if(and (<= (distance pt1 pt4) 600)(> (distance pt1 pt4) 100))
(progn (setq m1 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt1 pt4)
m2 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt2 pt3))
)))
(setq en(entmakex (list (cons 0 "LINE")(cons 10 m1)(cons 62 1)(cons 8 "中心线")(cons 11 m2))))
(if (/= en nil);
(progn(setq pt10-1 (cdr (assoc 10 (entget en))))
(setq pt11-1 (cdr (assoc 11 (entget en))))
(setq m0 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt10-1 pt11-1))
(command "lengthen" en "")
(setq dd (getvar "perimeter"))
(setq dd1 (/ dd 1000))
(princ (strcat "\nL=" (rtos dd1 2 3)))
(setqstr(strcat "L=" (rtos dd1 2 3)"M"))
(setq ang (angle pt10-1 pt11-1))
(if (and(> ang (* 0.5 pi))(<= ang (* 1.5 pi)))
(setq ang (angle pt11-1 pt10-1))
ang
)
(entmake (list '(0 . "TEXT") (cons 1 str) (cons 10 m0) (cons 40 200)(cons 62 4)(cons 50 ang)(cons 8 "wekehe梁中线标注")))
)
) 具体楼主修改一下 求大师出手谢谢~~~~~~~~~~~~~~~~~~~~ 品茗新秀 发表于 2014-3-29 17:59 static/image/common/back.gif
具体楼主修改一下
十分感谢！ 品茗新秀 发表于 2014-3-29 17:58
我抄的哪位高手的，楼主看看，是否有用
(defun c:tt( /dist e1 e2 ent1 ent2 m1 pt1 pt2 ssl)
qq号码多少，我想加你 最佳答案是什么？我怎么看不到呢？请楼主再发一遍，好么？？
页:
[1]