669423907
发表于 2012-3-8 14:19:54
h008 发表于 2012-3-8 09:32 static/image/common/back.gif
我试试,我是菜鸟,写的代码不够漂亮!
(defun 2d_mid (pt1 pt2);求两点中点 这就是函数应该是来自是明 ...
有点小问题:
清风明月名字
发表于 2012-3-16 10:12:26
谢谢楼主,下载用了,很好
成仔
发表于 2012-4-27 13:11:43
很好啊 ,支持
sdwy196912
发表于 2012-4-27 13:24:22
这个必须顶
T_T
发表于 2012-4-27 13:34:29
谢谢楼主,好用不错,
梦醒才知原是梦
发表于 2012-4-27 13:54:26
好东西。。。谢谢分享~~~~
xiaoyingzi
发表于 2012-4-27 22:59:54
本帖最后由 xiaoyingzi 于 2012-4-28 13:25 编辑
修改一下,支持框选,支持圆、圆弧、椭圆、矩形,去掉了平行线
;;源码来自明经通道-燃烧
;;支持圆、圆弧、椭圆、矩形框选加中心线
;;xiaoyingzi修改,增加支持框选和椭圆
(defun c:zxx (/ v1 v2 v3ss n in en endata entype cenpt r
b l dist ptlist p1 p2 p3 p4 pt1 pt2 pt3 pt4 )
;获得点p1和p2两点的中点坐标
(defun MidPof2P (p1 p2)
(mapcar '(lambda(x y) (/ (+ x y) 2.0) ) p1 p2)
)
(setq v1 (getvar "osmode"))
(setq v2 (getvar "cmdecho"))
(setq v3 (getvar "clayer"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(princ "\n选择要加中心线的圆、圆弧、椭圆、矩形!")
(if (setq ss (ssget (list(cons 0 "ARC,CIRCLE,ELLIPSE,LWPOLYLINE"))))
(progn
(setq n (sslength ss) in 0)
(repeat n
(setq en (ssname ss in) in (1+ in))
(setq endata (entget en))
(setq entype (cdr (assoc 0 endata)))
(cond
((or (= "CIRCLE" entype) (= "ARC" entype)) ;圆、圆弧
(setq cenpt (cdr (assoc 10 endata)))
(setq r (cdr (assoc 40 endata)))
(setq dist (* r 0.4))
(setq pt1 (polar cenpt pi (+ dist r))
pt2 (polar cenpt 0 (+ dist r))
pt3 (polar cenpt (* 0.5 pi) (+ dist r))
pt4 (polar cenpt (* 1.5 pi) (+ dist r))
)
)
((= "ELLIPSE" entype) ;椭圆
(setq cenpt (cdr (assoc 10 endata)))
(setq l (distance (list 0 0) (cdr (assoc 11 endata))))
(setq b (* (cdr (assoc 40 endata)) l))
(setq rotangle (angle (list 0 0) (cdr (assoc 11 endata))))
(setq dist (* b 0.4))
(setq pt1 (polar cenpt rotangle (+ l dist))
pt2 (polar cenpt (+ pi rotangle) (+ l dist))
pt3 (polar cenpt (+ (* 0.5 pi) rotangle) (+ b dist))
pt4 (polar cenpt (+ (* 1.5 pi) rotangle) (+ b dist))
)
)
((and (= "LWPOLYLINE" entype) (=(cdr (assoc 90 (entget en))) 4)) ;矩形
(setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) endata))
(setq ptlist (mapcar 'cdr ptlist)
p1 (nth 0 ptlist)
p2 (nth 1 ptlist)
p3 (nth 2 ptlist)
p4 (nth 3 ptlist)
)
(setq
b (distance p1 p2)
l (distance p1 p4)
pt1 (MidPof2P p1 p2)
pt2 (MidPof2P p3 p4)
pt3 (MidPof2P p1 p4)
pt4 (MidPof2P p2 p3)
)
(if (< b l)
(setq dist (* b 0.2))
(setq dist (* l 0.2))
)
(setq
pt1 (polar pt1 (angle pt2 pt1) dist)
pt2 (polar pt2 (angle pt1 pt2) dist)
pt3 (polar pt3 (angle pt4 pt3) dist)
pt4 (polar pt4 (angle pt3 pt4) dist)
)
)
)
(if (and pt1 pt2 pt3 pt4)
(progn
(if (not (tblsearch "LAYER" "Cen"))
(command "layer" "m" "Cen" "c" 2 "" "l" "center2" "" "lw"
0.18 "" "")
)
(command "layer" "s" "cen" "")
(command "line" pt1 pt2 "")
(command "line" pt3 pt4 "")
(setvar "clayer" v3)
)
)
)
)
)
(setvar "osmode" v1)
(setvar "cmdecho" v2)
(princ)
)
smartstar
发表于 2012-4-28 06:13:00
手机上网,回头试用。
xiaoyingzi
发表于 2012-4-28 13:26:15
更新了下,支持椭圆
功夫佬
发表于 2012-4-30 20:54:08
这个是别人开发的智能中心线,目前还没发现谁上传像这样的中心线,本人以现还没有能力,但相信以后肯定能写出来,可惜没有参考,无法去研究。