高程点压盖自动避让

蓝图测绘

不知不觉业余学习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 (- x  bzg) (+ 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

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

shiyj

支持支持，好东西

技术工作室

支持支持，好东西

newbuser

抢个沙发先。

蓝图测绘

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

╰☆珊瑚玉ヤ

谢谢分享
元旦快乐！

qhh6066

新年快乐！学习一下！

树櫴希德

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

杜阳

支持了    希望出好的作品

xiabin68

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

hejiazhao

看哈效果如何

461045462

谢谢楼主分享。
收藏下来，看看、学习学习