转别人的 cad展点号

gaomingabc456

;;;;数据文件格式【1、(点号，南北，东西，高程) 2、(点号  南北  东西  高程)】
(defun   c:kszd ()   ;;;cad展点号
  (setq        ff   (open (getfiled "请选择要展点的数据文件" "" "txt" 2) "r")
        fhb  nil
        t0   (getvar "cdate")
        cm   (getvar "cmdecho")
        os   (getvar "osmode")
        tcm1 "ZDH"
        tcm2 "PO"
  )
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setvar "pdmode" 35)
  (setvar "pdsize" 0.3)
  (if (= (tblsearch "layer" tcm1) nil)
    (command "layer" "n" tcm1 "")
  )
  (if (= (tblsearch "layer" tcm2) nil)
    (command "layer" "n" tcm2 "")
  )
  (while (setq zb (read-line ff))
      (while (vl-string-search "," zb)
      (setq zb (vl-string-subst " " "," zb))
    )
    (setq zb  (read (strcat "(" zb ")"))
           zb  (list (list (nth 2 zb) (nth 1 zb))  (vl-princ-to-string (car zb)) )                ;提示：注记点号请用该行     
           ;;;zb  (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string (last zb)))                ;提示：注记高程  请用该行     
          fhb (append fhb (list zb))
          )
    )
  (setq t1 (getvar "cdate"))
  (close ff)
  (setq        zb (vl-sort fhb
                    '(lambda (e1 e2) (< (car (car e1)) (car (car e2))))
           )
        x0 (car (car (car zb)))
        x1 (car (car (last zb)))
        zb (vl-sort fhb
                    '(lambda (e1 e2) (< (cadr (car e1)) (cadr (car e2))))
           )
        y0 (cadr (car (car zb)))
        y1 (cadr (car (last zb)))
  )
  (command "zoom" "w" (list x0 y0) (list x1 y1))
  (setq t2 (getvar "cdate"))
  (foreach zb fhb
    (setq zfc (last zb)
          ;pt  (mapcar '+ (car zb) '(1.5 -1.25));这行改为如下   
          pt  (car zb)
    )
    (entmake (list '(0 . "TEXT")
                   '(100 . "AcDbEntity")
                   '(100 . "AcDbText")
                   '(62 . 1)
                   '(40 . 0.3)
                   '(50 . 0.0)
                                        ;(cons 8 tcm1)   (cons 1 zfc)  (cons 10 pt);这行改为如下     
                   (cons 8 tcm1)
                   (cons 1 zfc)
                   (cons 10 (mapcar '+ pt '(-0.20 +0.3)))
             )
    )
    (entmake (list '(0 . "POINT")
                   '(100 . "AcDbEntity")
                   '(100 . "AcDbPoint")
                   '(62 . 2)
                   (cons 8 tcm2)
                   (cons 10 pt)
             )
    )
  )
  (setq        t3  (getvar "cdate")
        dt1 (* 1000000 (- t1 t0))
        dt2 (* 1000000 (- t3 t2))
  )
  (princ (strcat "读入数据共耗时："
                 (rtos dt1 2 3)
                 "秒   展点共耗时"
                 (rtos dt2 2 3)
                 "秒   展点数："
                 (itoa (length fhb))
                 "个   每展一点耗："
                 (rtos (/ dt2 (length fhb)) 2 10)
                 "秒"
         )
  )
  (setvar "cmdecho" cm)
  (setvar "osmode" os)
  (princ)

)

迷失1786

CAD插件管理程序

zhouzhiy

谢谢楼主分享！

kpl

还看不懂。需要学习啊

leedun

这个好像展不出高程来

yefei812678

还看不懂。需要学习啊