lisp移动高程压盖_移动高程点注记压盖图块、文字等地物避让最快算法思路征集...

(defun c:mgcd( / *error* data data_next dis e e_next i ii in_id key p1 p10 p11 p1010 p1-1 p2 p2-1 p3 p3-1 p4 p4-1 p5 p5-1 p6 p6-1 p7 p7-1 ppp ppp11 ss ssss  wz_cd wz_cd2 wz_gd)

(alert"高程点移位程序:\n只能处理1:500地形图。

\n\n不考虑等高线

\n\n高程点是CASS展出来没有拖动过的。

\n如果已经拖动了的不做处理。

\n\n如果程序无效

\n建议把高程回收一遍再重新展一次,然后运行本程序")

(defun *error*(msg)(princ))

(setq ssss(ssget '((2 . "GC200"))))

(setvar 'cmdecho 0)(setvar 'osmode 0)

(command "undo" "be")

(if(tblsearch "layer" "dgx")(command "._layer" "off" "dgx" ""))

(setq i -1)

(repeat(setq ii(sslength ssss))

(princ "\n")

(princ (setq ii(- ii 1)))

(setq e(ssname ssss (setq i(1+ i))))

(setq data(entget e '("*")))

(setq e_next(entnext e))

(setq data_next(entget e_next))

(setq wz_gd (cdr(assoc 40 data_next)));文字高度

(setq wz_cd (caadr(textbox data_next)));文字长度

(setq wz_cd2 (strlen (cdr(assoc 1 data_next))));文字真长

(setq in_id(assoc 10 data))

(command "zoom" "c" (cdr in_id) 30)

(setq p10(assoc 10 data_next))

(setq p11(assoc 11 data_next))

(setq dis(distance(list(cadr in_id)(caddr in_id))(list(cadr p11)(caddr p11))))

(if(equal dis 0.6 1E-3)

(progn

(setq p1010(mapcar '+ p10 (list 0 wz_cd wz_gd 0)))

;;;  ;;;下

;;;  (setq p1(mapcar '+ p10 (list 0 0 -1 0)))

;;;  (setq p1-1(mapcar '+ p1 (list 0 wz_cd wz_gd 0)))

;;;  ;;;下中

;;;  (setq p2(mapcar '+ p10 (list 0 -2 -1 0)))

;;;  (setq p2-1(mapcar '+ p2 (list 0 wz_cd wz_gd 0)))

;;;  ;;;左下

;;;  (setq p3(mapcar '+ p10 (list 0 -5.2 -1 0)))

;;;  (setq p3-1(mapcar '+ p3 (list 0 wz_cd wz_gd 0)))

;;;    ;;;左

;;;  (setq p4(mapcar '+ p10 (list 0 -5.2 -0 0)))

;;;  (setq p4-1(mapcar '+ p4 (list 0 wz_cd wz_gd 0)))

;;;      ;;;左上

;;;  (setq p5(mapcar '+ p10 (list 0 -5.2 1 0)))

;;;  (setq p5-1(mapcar '+ p5 (list 0 wz_cd wz_gd 0)))

;;;        ;;;上中

;;;  (setq p6(mapcar '+ p10 (list 0 -2 1 0)))

;;;  (setq p6-1(mapcar '+ p6 (list 0 wz_cd wz_gd 0)))

;;;          ;;;上

;;;  (setq p7(mapcar '+ p10 (list 0 0 1 0)))

;;;  (setq p7-1(mapcar '+ p7 (list 0 wz_cd wz_gd 0)))

;;;;;;  );;defun

(Setq key T)

(if

(and key(setq ss(ssget "_C" (cdr p10)(cdr p1010) '((8 . "~GCD")))))

(if(and  ;;;下

(setq p1(mapcar '+ p10 (list 0 0 -1.2 0)))

(setq p1-1(mapcar '+ p1 (list 0 wz_cd wz_gd 0)))

(null(setq ss(ssget "_C" (cdr p1)(cdr p1-1) ))))

(progn(setq ppp p1)(setq key nil)))

(setq key nil)

)

(if

(and key(setq ss(ssget "_C" (cdr p1)(cdr p1-1))))

(if(and;;;下中

(setq p2(mapcar '+ p10 (list 0 -2 -1.2 0)))

(setq p2-1(mapcar '+ p2 (list 0 wz_cd wz_gd 0)))

(null(setq ss(ssget "_C" (cdr p2)(cdr p2-1)))))

(progn(setq ppp p2)(setq key nil)))

(setq key nil)

)

(if

(and key(setq ss(ssget "_C" (cdr p2)(cdr p2-1))))

(if(and;;;左下

(setq p3(mapcar '+ p10 (list 0 -5.2 -1.2 0)))

(setq p3-1(mapcar '+ p3 (list 0 wz_cd wz_gd 0)))

(null(setq ss(ssget "_C" (cdr p3)(cdr p3-1)))))

(progn(setq ppp p3)(setq key nil)))

(setq key nil)

)

(if

(and key(setq ss(ssget "_C" (cdr p3)(cdr p3-1))))

(if(and ;;;左

(setq p4(mapcar '+ p10 (list 0 -5.2 -0 0)))

(setq p4-1(mapcar '+ p4 (list 0 wz_cd wz_gd 0)))

(null(setq ss(ssget "_C" (cdr p4)(cdr p4-1)))))

(progn(setq ppp p4)(setq key nil)))

(setq key nil)

)

(if

(and key(setq ss(ssget "_C" (cdr p4)(cdr p4-1))))

(if(and ;;;左上

(setq p5(mapcar '+ p10 (list 0 -5.2 1.2 0)))

(setq p5-1(mapcar '+ p5 (list 0 wz_cd wz_gd 0)))

(null(setq ss(ssget "_C" (cdr p5)(cdr p5-1)))))

(progn(setq ppp p5)(setq key nil)))

(setq key nil)

)

(if

(and key(setq ss(ssget "_C" (cdr p5)(cdr p5-1))))

(if(and ;;;上中

(setq p6(mapcar '+ p10 (list 0 -2 1.2 0)))

(setq p6-1(mapcar '+ p6 (list 0 wz_cd wz_gd 0)))

(null(setq ss(ssget "_C" (cdr p6)(cdr p6-1)))))

(progn(setq ppp p6)(setq key nil)))

(setq key nil)

)

(if

(and key(setq ss(ssget "_C" (cdr p6)(cdr p6-1))))

(if(and;;;上

(setq p7(mapcar '+ p10 (list 0 0 1.2 0)))

(setq p7-1(mapcar '+ p7 (list 0 wz_cd wz_gd 0)))

(null(setq ss(ssget "_C" (cdr p7)(cdr p7-1)))))

(progn(setq ppp p7)(setq key nil)))

(setq key nil)

)

;更新图元

(if (and ppp(null key))

(progn

(setq ppp11(mapcar '+ ppp '(1 0 0.5 0)))

(setq data_next(subst ppp (assoc 10 data_next)data_next))

(setq data_next(subst ppp11 (assoc 11 data_next)data_next))

(entmod data_next)

(entupd e)

(setq ppp nil ppp11 nil)

))

))

);repeat

(command "undo" "e")

(prin1)

)