新人报道，发几个源码，欢迎指正

lamntree

;;;定义总图中标准间距排列的俯视图，主视图，左视图中的基准点信息
(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 "[Front view/Left view]"))
  (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"))
)

461045462

谢谢楼主的分享
先下载来看看

ALXY

同顶，支持！

hhh454

支持分享，谢谢了，先下载看看