求助在CASS中利用LOG文件展高程点

树櫴希德

求助利用LOG文件展高程点,LOG文件格式如下:
  编号: 5252111,61055.433,11666.052,7.984
2,61055.612,11665.999,7.963
3,61057.374,11667.853,8.104
挖方: 0.00   填方: 0.15

编号: 2
1,61055.053,11666.662,8.101
2,61055.433,11666.052,7.984
3,61057.374,11667.853,8.104
挖方: 0.00   填方: 0.67

编号: 3
1,61055.489,11665.870,7.953
2,61055.433,11666.052,7.984
3,61055.612,11665.999,7.963
挖方: 0.00   填方: 0.02

编号: 4
1,61051.316,11661.480,7.620
2,61052.069,11665.129,8.096
3,61055.053,11666.662,8.101
挖方: 0.00   填方: 5.47

编号: 5
1,61051.316,11661.480,7.620
2,61055.053,11666.662,8.101
3,61055.433,11666.052,7.984
挖方: 0.00   填方: 2.38

编号: 6
1,61051.316,11661.480,7.620
2,61055.433,11666.052,7.984
3,61054.542,11664.874,7.878
挖方: 0.00   填方: 0.44
只利用其中三维坐标展点  ，其他不用管。
(defun gxl-cs:gcd (inspt height scale xsws / pt blkdef obj)  (setvar "CMDECHO" 0)
  (command "layer" "m" "检查高程点" "c" "1" "" "L" "CONTINUOUS" ""  "")
  (if height
    (setq height (rtos height 2 3))
    (setq height "")
  )
  (regapp "SOUTH")
  ;;;检查字体 "HZ" 是否存在
  (if (not (tblobjname "style" "HZ"))
    (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  )
  ;;;检查是否存在高程点图块定义
  (if (not (tblobjname "block" "GC200"))
    (progn
      (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
      (setq obj
        (vla-AddPolyline
           blkdef
           (vlax-make-variant
              (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbdouble (cons 0 5))
                 '(-0.2 0 0 0.2 0 0)
              )
           )
        )
      )
      (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
      (vla-put-Closed obj :vlax-true)
      (vla-put-ConstantWidth obj 0.4)
    )
  )
  ;;;插入块
  (entmake (list
             '(0 . "INSERT")
             '(100 . "AcDbEntity")
             '(100 . "AcDbBlockReference")
             '(66 . 1);;;属性跟随标志,1跟随，0不跟随
              (cons 2 "GC200")
              (cons 10 inspt)
              (cons 41 scale)
              (cons 42 scale)
              (cons 43 scale)
              '(-3 ("SOUTH" (1000 . "202101")))
           )
  )
  ;;;插入属性
  (entmake (list
             '(0 . "ATTRIB")
             '(100 . "AcDbEntity")
             '(100 . "AcDbText")
              (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
              (cons 40 (* 2.0 scale))
              (cons 50 0)
               (cons 62 2)
              (cons 41 0.8)
              (cons 51 0)
              (cons 1 height)
              (cons 7 "HZ")
              (cons 72 0)
              (cons 11 pt)
              '(100 . "AcDbAttribute")
              (cons 2 "height")
              (cons 70  0)
              (cons 74 2)
           )
   )
   ;;;结束标志
   (entmake '((0 . "SEQEND")))
   (princ)
)

(setq blc (getint "\n请输入比例尺1:"))
  (setvar 'userr1 blc);设置比例尺
  ;(setq zg (* 0.002 blc));字高
  (setq scale (* 0.001 blc));缩放比例


(defun _List:FromFile        (fn / f l ll)
    (if        (setq f (open (findfile fn) "r"))
      (progn
        (while (setq l (read-line f))
          (setq ll (cons l ll))
        )
        (close f)
      )
    )
    ll
  )
(if (setq fl (getfiled "Select Log file" "" "log" 8))
    (progn
      (setq lst         (_List:FromFile fl))

(while lst
        (setq nl  (cons        (list (car lst)
                              (cadr lst)
                              (caddr lst)
                              (nth 3 lst)
                              (nth 4 lst)
                        )
                        nl
                  )
              lst (cddr (cddddr lst))
        )
      )



      )
  )

搞不出来了  大家帮帮忙啊

树櫴希德

这是TXT文件 因为明经不能上传LOG文件

004

有大量重复点。。

树櫴希德

004 发表于 2015-6-15 13:35
有大量重复点。。

SY所以我用OVERKILL清除重复点 或者删除重复高程

树櫴希德

004 发表于 2015-6-15 13:35
有大量重复点。。

(alert "\n三角网破网标高注记SJWBGZJ")
(defun c:sjwbgzj ()
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
  (regapp "SOUTH")
  

(setq blc (getint "\n请输入比例尺1:<500>"))
  (if (= blc nil)(setq blc 500))
  (setvar 'userr1 blc);设置比例尺
(setq scale (* 0.001 blc));缩放比例
;;;by Gu_xl
(defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
  (setvar "CMDECHO" 0)
  (command "layer" "m" "bgGCD" "c" "1" "" "L" "CONTINUOUS" ""  "")
  (if height
    (setq height (rtos height 2 3));3为高程注记位数
    (setq height "")
  )
  (regapp "SOUTH")
  
  ;;;检查字体 "HZ" 是否存在
  (if (not (tblobjname "style" "HZ"))
    (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  )
  ;;;检查是否存在高程点图块定义
  (if (not (tblobjname "block" "GC200"))
    (progn
      (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
      (setq obj
        (vla-AddPolyline
           blkdef
           (vlax-make-variant
              (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbdouble (cons 0 5))
                 '(-0.2 0 0 0.2 0 0)
              )
           )
        )
      )
      (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
      (vla-put-Closed obj :vlax-true)
      (vla-put-ConstantWidth obj 0.4)
    )
  )
  ;;;插入块
  (entmake (list
             '(0 . "INSERT")
             '(100 . "AcDbEntity")
             '(100 . "AcDbBlockReference")
             '(66 . 1);;;属性跟随标志,1跟随，0不跟随
              (cons 2 "GC200")
              (cons 10 inspt)
              (cons 41 scale)
              (cons 42 scale)
              (cons 43 scale)
              (list -3 '("SOUTH" (1000 . "202101")))
           )
  )
  ;;;插入属性
  (entmake (list
             '(0 . "ATTRIB")
             '(100 . "AcDbEntity")
             '(100 . "AcDbText")
              (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
              (cons 40 (* 2.0 scale))
              (cons 50 0)
              (cons 41 0.8)
              (cons 51 0)
              (cons 1 height)
              (cons 7 "HZ")
             (cons 62 3)
              (cons 72 0)
              (cons 11 pt)
              '(100 . "AcDbAttribute")
              (cons 2 "height")
              (cons 70  0)
              (cons 74 2)
           )
   )
   ;;;结束标志
   (entmake '((0 . "SEQEND")))
   (princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun String:Split (str delimiter / post strlst stl)
    (if        str
      (progn
        (setq stl (strlen delimiter))
        (while (vl-string-search delimiter str)
          (setq        post   (vl-string-search delimiter str)
                strlst (cons (substr str 1 post) strlst)
                str    (substr str (+ 1 post stl))
          )
        )
        (reverse (vl-remove "" (cons str strlst)))
      )
    )
  )
;;;;;;;;
(defun XD::Pnt:SetZ (p z)
    (list (car p) (cadr p) (caddr p));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  )
  (defun str->pt (str)
    (XD::Pnt:SetZ
      (mapcar 'distof (cdr (String:Split str ",")))
      0.
    )
  )


(defun _List:FromFile        (fn / f l ll)
    (if        (setq f (open (findfile fn) "r"))
      (progn
        (while (setq l (read-line f))
          (setq ll (cons l ll))
        )
        (close f)
      )
    )
    ll
  )
(if (setq fl (getfiled "Select Log file" "" "log" 8))
    (progn
      (setq lst         (_List:FromFile fl))

(while lst
        (setq nl  (cons        (list (car lst)
                              (cadr lst)
                              (caddr lst)
                              (nth 3 lst)
                              (nth 4 lst)
                        )
                        nl
                  )
              lst (cddr (cddddr lst))
        )
      )

(mapcar '(lambda (x / pu n)
                 (setq pu (list (str->pt (cadr x))
                         (str->pt (caddr x))
                         (str->pt (cadddr x)))
                          
                       
                       
                 )
                 (foreach n pu
                  (gxl-cs:gcd n (caddr n) scale)     )
                 
                 
               )
              nl
      )
      
      )
  )
)