图块和文字对齐直线-均布直线-对齐多段线顶点-旋转平行
(defun c:duiqi ()
;将图块与直线对齐，并均分。
;先创建的图块排最右
;先等分的坐标排最右
;刚好对应了
(defun MoveToPosition (Blockname p_list / ent refPoint dx dy)
;移动对象到指定坐标
(prompt "\nSelect an object to move: ")
;获得图元名
;(setq ent (ssname (ssget) 0))
;获得图元信息
(setq entlist (entget blockname))
(princ entlist)
(setq targetx (car p_list))
(setq targety (cadr p_list))
;获得图元坐标
(setq zb (cdr (assoc 10 entlist)))
(princ zb)
(if blockname
(progn
(prompt "\nSpecify reference point for the object: ")
(setq refPoint zb)
;都移动到零点
;(setq targetX 0
; targetY 0
;)
(setq dx (- targetX (car refPoint)))
(setq dy (- targetY (cadr refPoint)))
(command "move" blockname "" "" (list dx dy 0) "")
(princ)
)
(princ "No entity selected.")
)
)
(defun GetPointList (startPoint endPoint n / pointList dx dy dz stepX stepY stepZ i)
(IF (< N 2)
(SETQ N 2)
)
(setq pointList nil)
(setq dx (- (car endPoint) (car startPoint)))
(setq dy (- (cadr endPoint) (cadr startPoint)))
(setq dz (- (caddr endPoint) (caddr startPoint)))
(setq stepX (/ dx (- n 1)))
(setq stepY (/ dy (- n 1)))
(setq stepZ (/ dz (- n 1)))
(setq i 0)
(while (< i n)
(setq point (list (+ (car startPoint) (* i stepX))
(+ (cadr startPoint) (* i stepY))
(+ (caddr startPoint) (* i stepZ))
)
)
(setq pointList (cons point pointList))
(setq i (+ i 1))
)
pointList
)
;; 示例用法:
;; (c:GetPointList '(0.0 0.0 0.0) '(100.0 100.0 0.0) 5)
;; 这将返回从(0, 0, 0)到(100, 100, 0)的4个等分点的列表
;只选择图块，67 0只得模型空间
(princ "\n请选择图块：")
(Setq SS1 (SsGet (list (cons 0 "INSERT,MTEXT,TEXT") (cons 67 0))))
;获得直线句柄
(princ "\n请选择要对齐的直线：")
(SETQ LNAME (SSNAME (SSGET) 0))
;获得直线信息
(setq L_list (entget lname))
;获得起始坐标
(setq startP (cdr (assoc 10 l_list)))
;获得终点坐标
(setq EndP (cdr (assoc 11 l_list)))
(princ startp)
(princ "\n")
(princ endp)
(list startp endp)
;(setq n (GetInt "请输入分割数量："))
(setq n (sslength ss1))
;获得等分坐标
(setq Block_Plist (GetPointList startp endp n))
(princ block_plist)
;移动图块到坐标
;按坐标放置图块
(Repeat (SsLength SS1)
(Setq Blockname (SsName SS1 0))
(SsDel blockname SS1)
(movetoposition blockname (car block_plist))
(setq block_plist (cdr block_plist))
)
)
(defun c:duidui ()
;沿多段线对齐对象与多段线的各个顶点
(defun MoveToPosition (Blockname p_list / ent refPoint dx dy zb)
;移动对象到指定坐标
(prompt "\nSelect an object to move: ")
;获得图元名
;(setq ent (ssname (ssget) 0))
;获得图元信息
(setq entlist (entget blockname))
(princ entlist)
(setq targetx (car p_list))
(setq targety (cadr p_list))
;获得图元坐标
(setq zb (cdr (assoc 10 entlist)))
(princ zb)
(if blockname
(progn
(prompt "\nSpecify reference point for the object: ")
(setq refPoint zb)
;都移动到零点
;(setq targetX 0
; targetY 0
;)
(setq dx (- targetX (car refPoint)))
(setq dy (- targetY (cadr refPoint)))
(command "move" blockname "" "" (list dx dy 0) "")
(princ)
)
(princ "No entity selected.")
)
)
(vl-load-com)
(princ "\n请选择多段线：")
(setq ss (ssget))
(setq thename (ssname ss 0))
(ssdel thename ss)
(setq line_info (entget thename))
(setq zuma (caar line_info))
(princ zuma)
(setq zuobiao (vl-remove-if-not '(lambda (pair) (= (car pair) 10)) line_info))
;(princ zuobiao)
;(princ zb3)
;(command-s "_.move")
(setq zb ())
(while zuobiao
(setq zb (cons (list (cadr (car zuobiao)) (caddr (car zuobiao))) zb))
(setq zuobiao (cdr zuobiao))
)
(princ zb)
;将选中的对象移动到多段线端点
(princ "\n请选择要对齐的对象：")
(setq ss1(ssget (list (cons 0 "INSERT,TEXT,MTEXT") (cons 67 0))))
;按坐标放置图块
(IF SS1
(Repeat (SsLength SS1)
(if zb
(progn
(Setq Blockname (SsName SS1 0))
(SsDel blockname SS1)
(movetoposition blockname (car zb))
(setq zb (cdr zb))
)
)
)
)
(princ)
)
