批量更改高程值
(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) "个点" ))
) 这个怎么用啊？ 批量修改中也碰到了问题，你设定的像素类别是"insert"但是一幅拼接的图纸中，高程的类别多样，有"insert" , "text" 甚至有些看不懂，该如何处理为好? 如果是“text”像素，可以这么做，
(defun c:gc ()
(princ "\n批量修改高程，可自由选择需要修改的高程点，并可指定修改后高程标注的高度，宽高比，注意：修改后的高程会归入“高程层”")
(setqhh(getreal "\n高程修正值："))
(setqaa(getreal "\n字体的大小："))
(setqbb(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 的分享
楼主的不知道怎样操作
谢谢
页:
[1]