批量提取图案填充高程点高程坐标

树櫴希德

由于在有些地形图中，软件生成高程点时点位不像CASS那样是个INSERT，也不像SCS那样是个POINT,有些是HATCH 有些是圆弧 园 多段线等等，提取圆弧坐标已经被zzxxoo大神解决，提取图案填充中心坐标由SKG123大神程序+[q3_2006]q2大神代码合并而成，在此感谢2位大神！
(defun c:TQWZZB()
   (princ "\n选择所需输出的点（point）:")
   (setq ss (ssget '((0 . "hatch")) ));;选取坐标点
   (setq n (sslength ss ));计算坐标点数量
        (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径
   (setq i 0)
   (repeat n
  (setq spt (ssname ss i ))
    ;(setq ept (entget spt))


;(setq pzx (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget (car (entsel))))))
     (setq pzx (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget spt))))
(setq lxyz (list (nth 0 (cadr pzx)) (nth 1 (cadr pzx)) (nth 2 (car pzx))        ))

(setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符
       (setq sy (rtos (nth 0 lxyz)))
       (setq sz (rtos (nth 2 lxyz)))
                                        (setq i1 (+ i 1));计算点序号
                                        (setq sn (rtos i1 2 0));将序号实数转换成字符
       (setq sxyz (strcat sn",,"  sy ","  sx  ","  sz))
       (write-line sxyz ff)



    (setq i (+ i 1))
   );repeat
  (close ff)

)
(prompt "*只适合HATCH << 命令:TQWZZB >> *输出格式（点号,, Y，X，Z）**")
(prin1)





;(if (= (cdr (assoc 0 ept)) "TEXT")
    ; (progn
                                    (setq lxyz (cdr (assoc 10  ept)))
       ;(setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符
       ;(setq sy (rtos (nth 0 lxyz)))
       ;(setq sz (rtos (nth 2 lxyz)))
                                      ;  (setq i1 (+ i 1));计算点序号
                                       ; (setq sn (rtos i1 2 0));将序号实数转换成字符
       ;(setq sxyz (strcat sn",,"  sy ","  sx  ","  sz))
      ; (write-line sxyz ff)
  ;  )
   ; )

树櫴希德

在此奉上zzxxoo大神提取圆弧圆心坐标程序和提取图案填充测试图
(ALERT "明经论坛zzxxoo ")
(defun c:plyxzb(/ wjm fff ptlst i)
(setq wjm (getfiled "请指定要保存的坐标文件" "e:\\" "dat" 1))
(setq fff (open wjm "w"))


(if (setq ss (ssget '((0 . "ARC,CIRCLE")))) (progn
  (setq ptlst (list))
  (repeat (setq i (sslength ss))
   (setq ptlst (cons(cdr(assoc 10 (entget(ssname ss (setq i (1- i)))))) ptlst))
  )
  ptlst
))

(setq i 0)
(repeat (length ptlst)
  (setq ent1 (nth i ptlst))

  (write-line (strcat (itoa i) ",,"(rtos (car ent1) 2 3) "," (rtos (cadr ent1) 2 3) "," (rtos (caddr ent1) 2 3)) fff)
  (setq i (1+ i))

  )
(close fff)



)

树櫴希德

请大家热烈讨论

树櫴希德

@[树櫴希德]四川
【话唠】LLSheng_73■■■(275988734) 22:58:25
(defun hatchxyz(e)
  (setq e(vl-remove-if'(lambda(x)(/=(car x)10))(entget e)))
  (list(cadr(cdadr e))(caddr(cdadr e))(last(car e))))
【话唠】LLSheng_73■■■(275988734)  18:51:06
HATCH图元的第一个10组最后一个数值(z)和第二个数值的前两个数值(x y)
合并成了( x y z)


谢谢73哥

gzxl

支持下，图案填充高程点是啥软件生成的？

树櫴希德

73哥版本

(defun hatchxyz(e)  (setq e(vl-remove-if'(lambda(x)(/=(car x)10))(entget e)))
  (list(cadr(cdadr e))(car(cdadr e))(last(car e))))





(defun c:TQWZZB()
   (princ "\n选择所需输出的点（point）:")
   (setq ss (ssget '((0 . "hatch")) ));;选取坐标点
   (setq n (sslength ss ));计算坐标点数量
        (setq ff (open (getfiled "文件保存为" "f:/" "dat" 1) "w"));保存路径
   (setq i 0)
   (repeat n
  (setq spt (ssname ss i ))
    ;(setq ept (entget spt))



(setq lxyz (hatchxyz spt))

(setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符
       (setq sy (rtos (nth 0 lxyz)))
       (setq sh (rtos (/ (nth 2 lxyz) 1000)))
                                        (setq i1 (+ i 1));计算点序号
                                        (setq sn (rtos i1 2 0));将序号实数转换成字符
       (setq sxyz (strcat sn",,"  sx ","  sy  ","  sh))
       (write-line sxyz ff)



    (setq i (+ i 1))
   );repeat
  (close ff)

)
(prompt "*只适合TEXT点 << 命令:TQWZZB >> *输出格式（点号,, Y，X，Z）**")
(prin1)





;(if (= (cdr (assoc 0 ept)) "TEXT")
    ; (progn
                                    (setq lxyz (cdr (assoc 10  ept)))
       ;(setq sx (rtos (nth 1 lxyz)));将坐标值实数转换成字符
       ;(setq sy (rtos (nth 0 lxyz)))
       ;(setq sz (rtos (nth 2 lxyz)))
                                      ;  (setq i1 (+ i 1));计算点序号
                                       ; (setq sn (rtos i1 2 0));将序号实数转换成字符
       ;(setq sxyz (strcat sn",,"  sy ","  sx  ","  sz))
      ; (write-line sxyz ff)
  ;  )
   ; )

树櫴希德

论坛老是跟新浪微博脱钩

wmz

树櫴希德 发表于 2014-9-19 20:08
@[树櫴希德]四川
【话唠】LLSheng_73■■■(275988734) 22:58:25
(defun hatchxyz(e)

来个山寨版的：
(defun HATCHxyz(e)
  (setq e(entget e)p(nth 18 e)
        p(list(cadr p)(caddr p)(last(nth 9 e))))
)

树櫴希德

热心人就是多啊

杜阳

搞测量的不多啊  支持了 强烈支持