xuyajun1979 发表于 2011-10-25 14:45:46

使用xline、line线分割转角标注

(defun c:ddqq (/ c c1 e pt3 pt4 pt1 pt2 pt list_1 list_2 hv ss1 m n)
(vl-load-com)
   (setvar "cmdecho" 0)
(command "_.undo" "_BE")
(setq test 1)
(while (/= test 0)
    (setq c (entsel "\n选择转角标注:"))
    (setq c1 (entget (car c)))
    (setq e (cdr (assoc 0 c1)))
    (if (= e "DIMENSION")
      (SETQ test 0)
      (prompt "\n 请选择转角标注！")
    )
)
(setq pt3 (cdr (assoc 13 c1))) ;标注脚点1
(setq pt4 (cdr (assoc 14 c1))) ;标注脚点2
(setq hv (cdr (assoc 50 c1)));标注方向
(if (or (= 0 hv)(= pi hv) ); hv＝0或pi时为水平方向，其余为垂直方向
    (setq pt4 (list (car pt4) (cadr pt3)))
    (setq pt4 (list (car pt3) (cadr pt4)))
)
(setq list_1 (list (list (car pt3) (cadr pt3) 0)))

;;获取线
;;========================================================
(setq ss1 (ssget (list (cons 0 "line,xline"))))
(setq m (sslength ss1))
(setq n 0)
(repeat m
    (setq s (ssname ss1 n))
    ;;求交点
    (setq en_data (entget s))
    (if (= "LINE" (cdr (assoc 0 en_data)))
      (progn
       (setq pt1 (cdr (assoc 10 en_data))) ;直线点1
       (setq pt2 (cdr (assoc 11 en_data))) ;直线点2
       (setq pt (inters pt1 pt2 pt3 pt4)) ;获取交点坐标
      )
      (progn
       (setq pt1 (cdr (assoc 10 en_data))) ;射线点1
       (setq pt2 (cdr (assoc 11 en_data))) ;射线点2
       (setq pt2 (list (+ (car pt2) (car pt1)) (+(cadr pt1) (cadr pt2))))      
       (setq pt (inters pt1 pt2 pt3 pt4 nil)) ;获取交点坐标
       (if (/= pt nil)
      (setq pt (inters pt1 pt pt3 pt4 )) ;获取交点坐标
       )
      )
    )
    (if (/= pt nil)
      (setq list_1 (append list_1 (list (list (car pt) (cadr pt) 0))))
    )
    ;;修改标注
    (setq n (+ 1 n))
)
(setq list_1 (append list_1 (list (list (car pt4) (cadr pt4) 0))))
(vl-load-com)
(if (> (length list_1) 1)
    (progn
      (if (/= 0 hv)
   ;按照Y值排序
(progn
   (setq list_2
   (vl-sort
   list_1
   (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
   )
   )
   (if (> (cadr pt3) (cadr pt4))
   (setq list_2 (reverse list_2))
   )
)
   ;按照X值排序
(progn
   (setq
   list_2 (vl-sort
       list_1
       (function (lambda (e1 e2) (< (car e1) (car e2))))
   )
   )
   (if (> (car pt3) (car pt4))
   (setq list_2 (reverse list_2))
   )
)
      )
    )
)
;;修改标注
(setq old_r (assoc 13 c1))
(setq new_r (cons 13 (nth 0 list_2)))
(setq old_r (assoc 14 c1))
(setq new_r (cons 14 (nth 1 list_2)))
(setq c1 (subst new_r old_r c1))
(entmod c1)
(setq n (length list_2))
(setq n (1- n))
(setq mm 0)
(repeat (1- n)
    (command "copy" c "" (nth mm list_2) (nth (1+ mm) list_2))
    (setq c (entlast))
    (setq c1 (entget c))
    (setq mm (1+ mm))
    (setq old_r (assoc 13 c1))
    (setq new_r (cons 13 (nth mm list_2)))
    (setq old_r (assoc 14 c1))
    (setq new_r (cons 14 (nth (1+ mm) list_2)))
    (setq c1 (subst new_r old_r c1))
    (entmod c1)
)
(command "_.undo" "_E")
(princ)
)

xiaxiang 发表于 2011-10-25 15:35:38

什么转角标注，能不能上个图

xuyajun1979 发表于 2011-10-25 16:10:31

E:\古建筑测量\001.gif
页: [1]
查看完整版本: 使用xline、line线分割转角标注