gaomingabc456 发表于 2017-8-4 10:52:21

cad 自动连线 <数据文件 格式为:[点号,南北,东西,高程,编码(Xn)] txt文件>

(defun c:cadzdct ();Cad自动成图
(setq os (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(setvar "pdmode" 35)
(setvar "pdsize" 0.3)
       
(setq        FF(open        (getfiled "请选择要展点成图的数据文件格式为:[点号,南北,东西,高程,编码(Xn)] txt文件" ""        "txt"        2) "r" ))
       
(setq xx nil)
(while
                (SETQ text0 (READ-LINE FF))
    (setq len (strlen text0))
    (setq XX0 (substr text0 (- len 1) 2))
    (setq n(vl-string-position (ascii ",") text0))
    (setq n1 (vl-string-position (ascii ",") text0 (1+ n )))
    (setq n2 (vl-string-position (ascii ",") text0 (1+ n1)))
    (setq n3 (vl-string-position (ascii ",") text0 (1+ n2)))
    (setq xh (substr text0 1 n)
                        x(atof (substr text0 (+ n 2)(- n1 (+ n 2))))
                        y(atof (substr text0 (+ n1 2) (- n2 (1+ n1))))
                       
                        pt (list y x)
                        p1 (list (- (car pt) 0.50) (+ (cadr pt) 0.20))
                        p2 (list (+ (car pt) 0.26) (- (cadr pt) 0.40))
                       
                        bg (substr text0 (+ n2 2) (- n3 (1+ n2)))
    )
    (entmake (list '(0 . "TEXT")        ;(setq text1 (list
                                                       '(100 . "AcDbEntity")
                                                       '(100 . "AcDbText")
                                                       '(67 . 0)
                                                       '(62 . 1)
                                                       ;'(8 . "0")
                                                       (cons 10 p1)   ;(cons 10 (mapcar '+ pt ' (- 0.50 + 0.20)))
                                                       
                                                       '(40 . 0.2)
                                                       (cons 1 xh)
                                               )
    )
    (entmake (list '(0 . "TEXT")        ;(setq text2 (list
                                                       '(100 . "AcDbEntity")
                                                       '(100 . "AcDbText")
                                                       ;'(67 . 0)
                                                       '(62 . 1)
                                                       ; '(8 . "0")
                                                       (cons 10 p2)    ; (cons 10 (mapcar '+ pt ' (+ 0.26 - 0.40)))
                                                       
                                                       '(40 . 0.4)
                                                       (cons 1 bg)
                                               )
    )
    (entmake (list '(0 . "POINT")
                                                       '(100 . "AcDbEntity")
                                                       '(100 . "AcDbPoint")
                                                       '(62 . 2)
                                                       ;;;(cons 8 tcm2)
                                                       (cons 10 pt)
                                               )
    )
                ;;;    (entmake text1)
                ;;;    (entmake text2)
    (if        (/= xx0 xx)
      (progn
                                (command "")
                                (command "pline" pt)
      )
      (command pt)
    )
    (setq xx xx0)
)
(command "")
(CLOSE FF)
(command "zoom" "e" "")
       
(setvar "OSMODE" os)
(setvar "CMDECHO" 1)
        (prin1)
)

gaomingabc456 发表于 2017-8-4 10:54:43

附样例一份：
G1,60147.2569,62044.552,94.3331,X1
G2,60146.4835,62058.8999,94.5603,X1
G3,60147.0962,62062.1774,94.7816,X1
G4,60148.3312,62065.1687,94.8666,X1
G5,60149.0107,62074.3351,94.9963,X1
G6,60146.3431,62093.4724,95.056,X1
G7,60146.0755,62096.8181,95.0341,X1
G8,60145.2671,62101.2077,94.7211,X1
G9,60144.0095,62105.8998,94.9201,X1
G10,60140.2258,62103.7108,94.933,X1
G11,60135.4384,62099.8754,94.9574,X1
G12,60130.6881,62094.3362,94.9934,X1
G13,60125.5123,62083.4144,94.7114,X1
G14,60125.5907,62076.8919,94.861,X1
G15,60125.5622,62063.3476,94.8452,X1
G16,60119.3761,62056.2432,94.2808,X1
G17,60119.4145,62043.6756,94.3599,X1
G18,60131.0393,62043.9197,94.3141,X1
G19,60138.7982,62044.1048,94.3293,X1

保存为   **.txt    ，文件名随便。

柴月二号 发表于 2017-12-3 10:33:46

前辈 bg的值如何改成编码 而不是高程标注到图

柴月二号 发表于 2017-12-3 11:02:44

仔细研究了一下，自己解决了，感谢前辈提供程序

wangyonggao8 发表于 2018-7-19 07:26:58

程序编复杂了，用vl-string-translate 直接把","替换成空格，然后构成表，是不是比你简单。
页: [1]
查看完整版本: cad 自动连线 <数据文件 格式为:[点号,南北,东西,高程,编码(Xn)] txt文件>