yjpzc 发表于 2013-1-26 23:54:18

CASS 点状物自动展绘 源码

(defun c:zdh( / acaddocument acadobject bm data_csv dh dhlist ff_csv file_csv h nn p pp ppp pt ptlist x y)
      (setvar "cmdecho" 0)
      (setq file_csv(getfiled "选取DAT文件" "" "DAT" 2))
      (setq ff_csv(open file_csv "r"))
      (setq pp nilptlist nil dhlist nil)
      (while (setq data_csv(read-line ff_csv))
               ;(setq csvpt(atof data_csv))
               ;(if (= data_csv "XSJ")
               (setq p "" pp "" ppp '() i 1)
               (setq nn(strlen data_csv))
               (repeat nn
                     (setq p (substr data_csv i 1))
                     (if (/= p ",")
                           (setq pp(strcat pp p))
                           (setq ppp(cons pp ppp) pp "")
                           )
                        (setq i(1+ i))
                        )
               (setq ppp(cons pp ppp))
               (setq ppp(reverse ppp))
               (setq dh(atoi(nth 0 ppp)))
               (setq bm(nth 1 ppp))
               (setq x (nth 2 ppp))
               (setq y (nth 3 ppp))
               (setq h (nth 4 ppp))
               (setq pt(strcat x "," y "," h))
               ;(setq pt (list y x h))
               (vl-load-com)
                               (setq acadobject(vlax-get-acad-object))
                               (setq acaddocument(vla-get-activedocument acadobject))
                                       (cond((= bm "XSJ")
                                              (progn
                                              (vla-sendcommand acaddocument "xsj")
                                              (vla-sendcommand acaddocument "\r")
                                              (vla-sendcommand acaddocument pt)
                                              (vla-sendcommand acaddocument "\r")
                                             )
                                             )
                                                ;;;;;;;电力井;;;;;;;;;
                                                ((= bm "DLJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "dlj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
                                                ;;;;;;;圆污水井;;;;;;;;;
                                                ((= bm "WSJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "wsj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
                                                ;;;;;;;方形污水井;;;;;;;;;
                                                ((= bm "FWS")
                                                 (progn
                                                         (vla-sendcommand acaddocument "fws")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocument "90")
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                          )
                                                ;;;;;;;电线杆;;;;;;;;;
                                                ((= bm "DXG")
                                                 (progn
                                                         (vla-sendcommand acaddocument "dxg")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )   
                                                          )
                                                ;;;;;;;下水暗井;;;;;;;;;
                                                ((= bm "SAJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "saj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocument pt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                          )
                                                 ;;;;;;;天然气煤气井;;;;;;;;;
                                                ((= bm "MQJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "mqj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocument pt)
                                                         (vla-sendcommand acaddocument "\r")
                                                       )
                                                       )                     
                                                               
                                                   ;;;;;;;电信入井;;;;;;;;;
                                                ((= bm "DXJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "dxj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                          )                        
                                                 ;;;;;;;电信手井;;;;;;;;;
                                                ((= bm "DXS")
                                                 (progn
                                                         (vla-sendcommand acaddocument "dxs")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
                                                                                    
                                                 ;;;;;;;石油井;;;;;;;;;
                                                ((= bm "SYJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "syj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                          )
                                                ;;;;;;;不明用途井;;;;;;;;;
                                                ((= bm "BMJ")
                                                 (progn
                                                          (vla-sendcommand acaddocument "bmj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                          )
                                                    ;;;;;;;热力井;;;;;;;;;
                                                ((= bm "RLJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "rlj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                      )   
                                                      )                                       
                                                   ;;;;;;;上水井;;;;;;;;;
                                                ((= bm "SSJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "ssj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                          )
                                             ;;;;;;;消防栓;;;;;;;;;
                                                ((= bm "XFS")
                                                 (progn
                                                         (vla-sendcommand acaddocument "xfs")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                          )
                                             ;;;;;;;阀门;;;;;;;;;
                                                ((= bm "FM")
                                                 (progn
                                                         (vla-sendcommand acaddocument "fm")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                            )   
                                             ;;;;;;;水龙头;;;;;;;;;
                                                ((= bm "SLT")
                                                 (progn
                                                          (vla-sendcommand acaddocument "slt")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                          )      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;水系;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                                ;;;;;;;水井;;;;;;;;;
                                                ((= bm "SJ")
                                                 (progn
                                                         (vla-sendcommand acaddocument "sj")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )   
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;交通类;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                                 ;路标
                                                 ((= bm "LB")
                                                (progn
                                                         (vla-sendcommand acaddocument "lb")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
                                                 ;汽车站
                                                 ((= bm "QCZ")
                                                (progn
                                                          (vla-sendcommand acaddocument "qcz")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
                                                 ;里程碑
                                                 ((= bm "LCB")
                                                (progn
                                                         (vla-sendcommand acaddocument "lcb")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;交通类;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                                 ;散树
                                                ((= bm "XS")
                                                (progn
                                                         (vla-sendcommand acaddocument "xs")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocument pt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
                                                 ;阔叶
                                                 ((= bm "KYS")
                                                (progn
                                                         (vla-sendcommand acaddocument "kys")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                      )
                                                         )
                                                 ;针叶树
                                                 ((= bm "ZYS")
                                                (progn
                                                         (vla-sendcommand acaddocument "zys")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
                                                         
                                                 ;果树
                                                 ((= bm "GS")
                                                (progn
                                                          (vla-sendcommand acaddocument "gs")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                             )
                                                         )
                                                ;椰子
                                                 ((= bm "YZS")
                                                (progn
                                                          (vla-sendcommand acaddocument "yzs")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )      
                                                   ;竹丛
                                                 ((= bm "ZC")
                                                (progn
                                                         (vla-sendcommand acaddocument "zc")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )                                             
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                                   ;亭
                                                 ((= bm "TZ")
                                                (progn
                                                      (vla-sendcommand acaddocument "tz")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
                                                ;土地庙
                                                 ((= bm "TDM")
                                                   (progn
                                                         (vla-sendcommand acaddocument "tdm")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
                                                 ;路灯
                                                 ((= bm "LD")
                                                   (progn
                                                          (vla-sendcommand acaddocument "ld")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
                                                 ;垃圾台
                                                 ((= bm "LJT")
                                                   (progn
                                                          (vla-sendcommand acaddocument "ljt")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
                                                 ;旗杆
                                                ((= bm "QG")
                                                   (progn
                                                          (vla-sendcommand acaddocument "qg")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
                                                ;露天设备
                                                 ((= bm "LTSB")
                                                   (progn
                                                          (vla-sendcommand acaddocument "ltsb")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
                                                ;;;;;;;;照射灯;;;;;;      
                                                ((= bm "ZSD")
                                                   (progn
                                                          (vla-sendcommand acaddocument "zsd")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
                                                         
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;雷达站;;;;;   
                                                ((= bm "LDZ")
                                                (progn
                                                         (vla-sendcommand acaddocument "ldz")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
;;;;;;;;塑像;;;;;
   
                                                ((= bm "SX")
                                                (progn
                                                          (vla-sendcommand acaddocument "sx")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
;;;;;;;;避雷针;;;;
                                                ((= bm "BNZ")
                                                (progn
                                                         (vla-sendcommand acaddocument "bnz")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
;;;;;;;;钻孔;;;;;;
   
                                                ((= bm "ZK")
                                                (progn
                                                         (vla-sendcommand acaddocument "zk")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;散坟;;;;;;   
                                                ((= bm "SF")
                                                (progn
                                                          (vla-sendcommand acaddocument "sf")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocumentpt)
                                                         (vla-sendcommand acaddocument "\r")
                                                          )
                                                         )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;独立坟;;;
                                                ((= bm "DLF")
                                                (progn
                                                          (vla-sendcommand acaddocument "dlf")
                                                         (vla-sendcommand acaddocument "\r")
                                                         (vla-sendcommand acaddocument pt)
                                                         (vla-sendcommand acaddocument "\r")
                                                         )
                                                         )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
                                                )
                        ;(setq data_csv(read-line ff_csv))
                                       )
                           (close ff_csv)   
                           (print)      
                              )

wm123456 发表于 2018-3-7 13:10:24

dat格式要求是什么啊 能不能给个说明

happy336 发表于 2019-10-15 12:02:32

谢谢分享,支持

iamdjz 发表于 2013-1-27 11:37:11

本帖最后由 iamdjz 于 2013-1-27 11:46 编辑

这个cond太长了。
能不能写成这样形式:
(setq command_list '(("XSJ") ("DLJ") ("WSJ") ("FWS").....未列完))

(setq cat (assoc bm command_list ) )
(if (/= cat nil)
(progn
(setq cat (car cat) )
(setq cock (strcase cat T))
   (vla-sendcommand acaddocumentcock)
      (vla-sendcommand acaddocument "\r")
      (vla-sendcommand acaddocument pt)
      (vla-sendcommand acaddocument "\r")
)
)

vla-sendcommand 之类的命令(我不懂这个)可否用(command cock“” pt “”)代替?
方污水井要单列一下。

xiabin68 发表于 2013-1-27 11:38:40

顶一个,写的真长呀!

gzxl 发表于 2013-1-27 22:23:38

xiabin68 发表于 2013-1-27 11:38 static/image/common/back.gif
顶一个,写的真长呀!

好,支持楼主,我怎么每次都是在xiabin68之后啊

gzxl 发表于 2013-1-27 22:26:01

不管cond长不长,能分享就是一句话:好!呵呵

xiabin68 发表于 2013-1-27 23:27:25

gzxl 发表于 2013-1-27 22:23 static/image/common/back.gif
好,支持楼主,我怎么每次都是在xiabin68之后啊

我的脚比你洗的干净吧,,,

yjpzc 发表于 2013-1-28 09:56:51

iamdjz 发表于 2013-1-27 11:37 static/image/common/back.gif
这个cond太长了。
能不能写成这样形式:
(setq command_list '(("XSJ") ("DLJ") ("WSJ") ("FWS").....未列 ...

呵呵---   嗯 这样写就直接贴南方的编码vla-sendcommand acaddocument向命令行发送文字

yuanziyou 发表于 2013-1-28 11:08:22

为什么要舍近求远呢?
直接用cass自带的简码识别就可以满足要求啊!

cuyong 发表于 2013-1-28 11:59:50

怎么没有数据格式了?郁闷

461045462 发表于 2013-2-1 22:23:35

谢谢楼主的分享!
收藏下来看看、学习学习。
页: [1] 2 3
查看完整版本: CASS 点状物自动展绘 源码