批量更改高程值

yjpzc

(defun c:plmj()
      (setq dd-h(getreal "\n请输入高程修正值:"))
      (vl-load-com)
      (setq ss(ssget))
      (setq n 0)
      (while (< n (sslength ss))
              (setq ent(ssname ss n))
              (setq en (entget ent))
              ;(setq ty (cdr (assoc -1 en)))
              (if (= (cdr (assoc 0 en)) "INSERT")
                  (progn
                  (setq xy-lisp(assoc 10 en))
                  (setq xy-lsp(cdr xy-lisp))
                  (setq old-h(nth 2 xy-lsp))
           (setq new-h(+ dd-h old-h))
           (setq new-lsp(cons 10 (list (nth 0 xy-lsp) (nth 1 xy-lsp) new-h)))
           (setq en(subst new-lsp xy-lisp en))
           (entmod en)
                  (setq t1 (vlax-ename->vla-object ent))
                  (setq t2 (vla-GetAttributes t1))
                  (setq t3 (vlax-variant-value t2))
                  (setq t4 (vlax-safearray->list t3))
                  (setq t5 (car t4))
                  (setq tt5 (vla-get-textstring t5))
                  (setq tt6 (vl-string-position (ascii ".") tt5))
                  (setq tt7 (substr tt5 (+ tt6 2)))
                  (setq tt8 (strlen tt7))  
                  (setq t7 (rtos new-h 2 tt8))
                  (vla-put-textstring t5 t7)
                  (setq t8 (vlax-vla-object->ename t5))
                  (setq t9 (entget t8))
                  (setq t10 (assoc 10 t9))
                  (setq t11 (cdr t10))
                  (setq t12 (list 10 (car t11) (cadr t11) (+ (caddr t11) dd-h)))
                  (entmod (subst t12 t10 t9))
                  (vla-update t5)
    )
       )
              (setq n(1+ n))
              )
              (princ (strcat "\n" "共处理" (itoa n) "个点" ))
  )

crazylsp

这个怎么用啊？

jackynine

批量修改中也碰到了问题，你设定的像素类别是"insert"  但是一幅拼接的图纸中，高程的类别多样，有"insert" , "text" 甚至有些看不懂，该如何处理为好?

jackynine

如果是“text”像素，可以这么做，
(defun c:gc ()
(princ "\n批量修改高程，可自由选择需要修改的高程点，并可指定修改后高程标注的高度，宽高比，注意：修改后的高程会归入“高程层”")
(setq  hh(getreal "\n高程修正值："))
(setq  aa(getreal "\n字体的大小："))
(setq  bb(getreal "\n字体宽高比："))
(if (setq ss (ssget '((0 . "text") (1 . "1*.*,2*.*,3*.*,4*.*,5*.*,6*.*,7*.*,8*.*,9*.*"))))
    (progn
      (setq i -1 )
      (while (setq s1 (ssname ss (setq i (1+ i))))
        (setq s1 (entget s1))
        (setq old (atof (cdr (assoc 1 s1))) new (+ hh old))
        (setq new1 (rtos new 2 2))
        (setq s1 (subst (cons 1 new1) (assoc 1 s1) s1))
        (if aa (setq s1 (subst (cons 40 aa) (assoc 40 s1) s1)))
        (if bb (setq s1 (subst (cons 41 bb) (assoc 41 s1) s1)))
        (setq s1 (subst (cons 8 "高程层") (assoc 8 s1) s1))
        (entmod s1)
      )
    )
  )
  (princ (strcat "\n" "共处理" (itoa i) "个点" ))
)

jackynine

对于其他的情况正在想办法处理。

461045462

谢谢jackynine 的分享
楼主的不知道怎样操作
谢谢

wdjy808