新人报道，发几个源码，欢迎指正
;;;定义总图中标准间距排列的俯视图，主视图，左视图中的基准点信息(defun C:df (/ pt-t pt-f pt-l)
(setq pt-t (getpoint "\n指定第一张俯视图下侧基准线上的点(0,0)\n"))
(if (= pt-t nil)
(setq pt-t '(0 0))
)
(setq yt (cadr pt-t)
dt (getdist pt-t
"\n指定第二张俯视图下侧基准线上的点(0,100000)\n"
)
)
(if (= dt nil)
(setq dt 100000)
)
(setq
pt-f (getpoint "\n指定第一张主视图下侧基准线上的点(0,100000)\n")
)
(if (= pt-f nil)
(setq pt-f '(0 100000))
)
(setq yf (cadr pt-f)
df (getdist pt-f
"\n指定第二张主视图下侧基准线上的点(0,200000)\n"
)
)
(if (= df nil)
(setq df 100000)
)
(setq
pt-l (getpoint
"\n指定右侧第一张左视图的右侧基准线上的点(100000,100000)\n"
)
)
(if (= pt-l nil)
(setq pt-l '(100000 100000))
)
(setq xl (car pt-l)
dl (getdist pt-l
"\n指定右侧第二张左视图的右侧基准线上的点(0,100000)\n"
)
)
(if (= dl nil)
(setq dl 100000)
)
)
;;;移动对象到x轴方向上的对齐位置
(defun C:mx (/ ed pt-2 x2 pt-1 x1 y1 l)
(princ "\n指定要对齐的移动对象\n")
(setq ed (ssget)
pt-2 (getpoint "\n指定对齐目标的x基准点\n")
x2 (car pt-2)
pt-1 (getpoint "\n指定移动对象的x基准点\n")
x1 (car pt-1)
y1 (cadr pt-1)
l (getreal "\n指定相对移动水平距离")
)
(if (= l nil)
(setq l 0)
)
(setq l (- (+ x2 l) x1))
(command "move"
ed
""
(list l 0)
""
)
(command "zoom" "c" (list (+ x2 l) y1) "")
)
;;;移动对象到y轴方向上的对齐位置
(defun C:my (/ ed pt-2 y2 pt-1 y1 x1 h)
(princ "指定要对齐的移动对象\n")
(setq ed (ssget)
pt-2 (getpoint "\n指定同一视图上对齐目标的y基准点")
y2 (cadr pt-2)
pt-1 (getpoint "\n指定同一视图上移动对象的y基准点")
y1 (cadr pt-1)
x1 (car pt-1)
h (getreal "\n指定相对移动高度")
)
(if (= h nil)
(setq h 0)
)
(setq h (- (+ y2 h) y1))
(command "move"
ed
""
(list 0 h)
""
)
(command "zoom" "c" (list x1 (+ y2 h)) "")
)
;;;根据df函数对全局变量dl的定义，移动对象到左视图x轴方向上的对齐位置
(defun C:lx (/ ed pt-2 x2 pt-1 x1 y1)
(princ "\n指定左视图上要对齐的移动对象\n")
(setq ed (ssget)
pt-2 (getpoint "\n指定左视图上对齐目标的x基准点\n")
x2 (car pt-2)
pt-1 (getpoint "\n指定左视图上移动对象的x基准点\n")
x1 (car pt-1)
y1 (cadr pt-1)
)
(command "move"
ed
""
(list (- (rem (- xl x1) dl) (rem (- xl x2) dl))
0
)
""
)
(command "zoom"
"c"
(list (+ x1 (- (rem (- xl x2) dl) (rem (- xl x1) dl))) y1)
""
)
)
;;;根据df函数对全局变量df,yf的定义，移动对象到主视图、左视图高度方向上的对齐位置
(defun C:fy (/ ed pt-2 y2 pt-1 x1 y1)
(princ "\n指定主视图或左视图上要对齐的移动对象\n")
(setq ed (ssget)
pt-2 (getpoint "\n指定主视图或左视图上对齐目标的y基准点")
y2 (cadr pt-2)
pt-1 (getpoint "\n指定主视图或左视图上移动对象的y基准点")
x1 (car pt-1)
y1 (cadr pt-1)
)
(command "move"
ed
""
(list 0
(- (rem (- y2 yf) df) (rem (- y1 yf) df))
)
""
)
(command
"zoom"
"c"
(list x1 (+ (- (rem (- y2 yf) df) (rem (- y1 yf) df)) y1))
""
)
)
;;;根据df函数对全局变量dt,yt的定义，移动对象到俯视图高度方向上的对齐位置
(defun C:ty (/ ed pt-2 y2 pt-1 x1 y1)
(princ "\n指定俯视图上要对齐的移动对象\n")
(setq ed (ssget)
pt-2 (getpoint "\n指定俯视图上对齐目标的y基准点")
y2 (cadr pt-2)
pt-1 (getpoint "\n指定俯视图上移动对象的y基准点")
x1 (car pt-1)
y1 (cadr pt-1)
)
(command "move"
ed
""
(list 0
(- (rem (- y2 yt) dt) (rem (- y1 yt) dt))
)
""
)
(command
"zoom"
"c"
(list x1 (+ (- (rem (- y2 yt) dt) (rem (- y1 yt) dt)) y1))
""
)
)
;;;根据df函数对全局变量dl,dt,yt的定义，移动对象到左视图x轴方向上的对齐位置
(defun C:tl (/ ed pt-2 y2 pt-1 x1 y1)
(princ "\n指定左视图上要对齐的移动对象\n")
(setq ed (ssget)
pt-2 (getpoint "\n指定俯视图上对齐目标的y基准点")
y2 (cadr pt-2)
pt-1 (getpoint "\n指定左视图上移动对象的x基准点")
x1 (car pt-1)
y1 (cadr pt-1)
)
(command "move"
ed
""
(list (- (rem (- xl x1) dl) (rem (- y2 yt) dt))
0
)
""
)
(command
"zoom"
"c"
(list (+ x1 (- (rem (- xl x1) dl) (rem (- y2 yt) dt))) y1)
""
)
)
;;;根据df函数对全局变量dl,dt,yt的定义，移动对象到俯视图y轴方向上的对齐位置
(defun C:lt (/ ed pt-2 x2 pt-1 x1 y1)
(princ "\n指定俯视图上要对齐的移动对象\n")
(setq ed (ssget)
pt-2 (getpoint "\n指定左视图上对齐目标的x基准点")
x2 (car pt-2)
pt-1 (getpoint "\n指定俯视图上移动对象的y基准点")
x1 (car pt-1)
y1 (cadr pt-1)
)
(command "move"
ed
""
(list 0 (- (rem (- xl x2) dl) (rem (- y1 yt) dt)))
""
)
(command
"zoom"
"c"
(list x1
(+ (- (rem (- xl x2) dl) (rem (- y1 yt) dt)) y1)
)
""
)
)
;;;绘制三维溜管在主视图或侧视图上的投影, 并给出三维溜管的实际长度
(defun C:ld (/ pt1 an x1 y1 key pta ptb xa
ya xb yb delta-x delta-y l ac-l
x2 y2
)
(command "_layer" "make" "spout-axis" "")
(setq pt1 (getpoint "\nspecify insertion point")
an(getangle "\nenter spout angle:")
)
(setq x1 (car pt1)
y1 (cadr pt1)
)
(while (and (< an 0) (> an (* (/ pi 180) 90)))
(progn
(alert "please enter a degree between 0 to 60")
(setq an (getangle "\nenter spout angle:"))
)
)
(initget "Front-view Left-view")
(setq key (getkword ""))
(princ
"\nplease specify start point and end point of projection line in the top view"
)
(setq pta (getpoint)
ptb (getpoint)
xa (car pta)
ya (cadr pta)
xb (car ptb)
yb (cadr ptb)
delta-x (- xb xa)
delta-y (- ya yb)
l (sqrt (+ (* delta-x delta-x) (* delta-y delta-y)))
ac-l (/ l (cos an))
)
(if (= key "Front-view")
(progn
(setq x2 (+ x1 delta-x)
y2 (- y1 (* l (/ (sin an) (cos an))))
)
(command "line" pt1 (list x2 y2) "")
)
(progn
(setq x2 (+ x1 delta-y)
y2 (- y1 (* l (/ (sin an) (cos an))))
)
(command "line" pt1 (list x2 y2) "")
)
)
(princ (strcat "actual length=" (rtos ac-l) "\n"))
) 谢谢楼主的分享
先下载来看看 同顶，支持！ 支持分享，谢谢了，先下载看看
页:
[1]