蓝图测绘 发表于 2013-12-31 23:47

高程点压盖自动避让

本帖最后由 蓝图测绘 于 2013-12-31 23:48 编辑


不知不觉业余学习lisp有4个月了，在新年到来之际，上一个小程序，程序比较简单，望高手们多提意见，以便更加完善。

;高程点压盖自动避让
(defun c:ygcd()
(setq
    osmode_old (getvar "osmode")
    cmdecho_old (getvar "cmdecho")
    clayer_old (getvar "clayer")
)
(setvar "cmdecho" 0)
(princ "\n请选择高程点")
(setq ss (ssget (List (cons 0 "INSERT") (cons 8 "GCD") (CONS 2 "GC200"))))
(setq i 0 m 0)
(if (= ss nil)
    (alert"没有选择到符合CASS条件的高程点\n图层为GCD、图块名为GC200")
)
(repeat (sslength ss)
    (setq gcdname (ssname ss i))
    (setq gcdsx (entget gcdname '("south")))
    (setq e (cdr (assoc -1 gcdsx)))
    (setq ent (entget e))
    (setq en (entget (setq ent (entnext e))))
    (setq zb (cdr (assoc 10 en)) x (car zb) y (cadr zb))
    (setq enLayer (cdr (assoc 8 en)))
    (setq bzg (/ (cdr (assoc 40 en)) 2))
    (setq pt zb)
    (jswk)
    (if (/= ss1 nil)
      (progn
      (scptb)
(setq k 0)
(while (and (/= ss1 nil) (< k 15))
   (setq pt (nth k ptb))
   (jswk)
   (if (= ss1 nil)
   (progn
       (setq pn (list x0 (+ y0 bzg)))
       (entmod (subst (cons 11 pn) (assoc 11 en) en))
       (setq m (1+ m))
   )
   )
   (setq k (1+ k))
)
      )
    )
    (setq i (1+ i))
)
(command "regen" "")
(setvar "osmode" osmode_old)
(setvar "cmdecho" cmdecho_old)
(setvar "clayer" clayer_old)
(princ "\n本次操作共移动了 ") (princ m) (princ " 个高程点")
(prin1)
)
(princ "\n====蓝图测绘，精心制作; 键入 ygcd 运行本插件====")
;;;计算高程注记外框
(defun jswk()
(setq x0 (car pt) y0 (cadr pt))
(setq pt0 (list x0 y0))
(setq box (textbox en))
(setq wx (- (car (cadr box)) (car (car box))))
(setq wy (- (cadr (cadr box)) (cadr (car box))))
(setq xt (+ x0 wx))
(setq yt (+ y0 wy))
(setq ptt (list xt yt))
(setq ss1 (ssget "_c" pt0 ptt (list '(-4 . "<NOT") (cons 8 enLayer) '(-4 . "NOT>"))))
)
;;;计算插入点
(defun scptb()
(setq pt1 (list x (+ y bzg)))
(setq pt2 (list x (- y bzg)))
(setq pt3 (list x (+ y (* 2 bzg))))
(setq pt4 (list x (- y (* 2 bzg))))
(setq pt5 (list (- x bzg) (- y (* 2 bzg))))
(setq pt6 (list (- x (* 2 bzg)) (- y (* 2 bzg))))
(setq pt7 (list (- x (* 3 bzg)) (- y (* 2 bzg))))
(setq pt8 (list (- x (* 4 bzg)) (- y (* 2 bzg))))
(setq pt9 (list (- x (* 5 bzg)) (- y (* 2 bzg))))
(setq pt10 (list (- x (* 6 bzg)) (- y (* 2 bzg))))
(setq pt11 (list (- xbzg) (+ y (* 2 bzg))))
(setq pt12 (list (- x(* 2 bzg)) (+ y (* 2 bzg))))
(setq pt13 (list (- x(* 3 bzg)) (+ y (* 2 bzg))))
(setq pt14 (list (- x(* 4 bzg)) (+ y (* 2 bzg))))
(setq pt15 (list (- x(* 5 bzg)) (+ y (* 2 bzg))))
(setq pt16 (list (- x(* 6 bzg)) (+ y (* 2 bzg))))
(setq ptb (list pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 pt15 pt16))
)

mpk023 发表于 2019-5-6 10:17

这个要怎么用？楼主能不能弄成附件。谢谢

shiyj 发表于 2022-12-4 22:55

支持支持，好东西

技术工作室 发表于 2022-9-30 15:24

支持支持，好东西

newbuser 发表于 2014-1-1 10:16

抢个沙发先。

蓝图测绘 发表于 2014-1-1 10:57

符合测量注记的优先级别顺序要求，一般不注记在4号位置

╰☆珊瑚玉ヤ 发表于 2014-1-1 11:32

谢谢分享
元旦快乐！

qhh6066 发表于 2014-1-3 23:50

新年快乐！学习一下！

树櫴希德 发表于 2014-1-4 09:39

蓝图测绘老师是测量界精英

杜阳 发表于 2014-1-13 17:02

支持了    希望出好的作品

xiabin68 发表于 2014-2-27 04:27

下来看一下，，支持一个，

hejiazhao 发表于 2014-3-6 20:36

看哈效果如何

461045462 发表于 2014-3-9 20:24

谢谢楼主分享。
收藏下来，看看、学习学习
页: [1] 2 3
查看完整版本: 高程点压盖自动避让