展点程序

王子

(defun c:zd ()
  (setq os (getvar "osmode"))
  (setq od (getvar "cmdecho"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq filename1 (getfiled "请打开展点文件名::::" "" "" 2))
  (setq bilichi (getreal "\n展点图比例尺分母<1000>=     "))
  (if (not bilichi)
    (setq bilichi 1000)
  )
  (setq bilichi (/ bilichi 1000))
  (if (not (tblsearch "layer" "999"))
    (vl-cmdf "layer" "m" "999" "")
  )
  (vl-cmdf "layer" "s" "0" "")
  (COMMAND "STYLE"
    "wygzd2"
    "fsdb_e,fsdb"
    (* 2.0 bilichi)
    "0.75"
    "0.0"
    "N"
    "N"
    "N"
  )
;;;  (vl-cmdf "pline")
  (setq fil1 (open filename1 "r"))
  (setq ii 0)
  (while (setq sth (read-line fil1))
    (progn
;;;(setq pth(read (strcat "(" sth ")" )))
;;;(setq pn1(nth 0 pth))
;;;(setq sth (read-line fil1))
      (setq pth (read (strcat "(" sth ")")))
;;;(setq pty1(nth 2 pth))
;;;(setq ptx1(NTH 1 pth))
      (setq pn1 (vl-princ-to-string (nth 0 pth)))
      (setq ptx1 (nth 1 pth))
      (setq pty1 (NTH 2 pth))
      (setq pth1 (nth 3 pth))      
      (if (= pth1 0)
(setq pt1 (list ptx1 pty1))
(setq pt1 (list ptx1 pty1 pth1))
      )
;;;(setq pn2 (rtos pn1 2 0))
      (setq pn2 pn1)
;;;      (vl-cmdf "_circle" pt1 (* 0.2 bilichi))
      (vl-cmdf "_insert"
;;;        "1.7"
        "g:/mtools/gc200.dwg"
        pt1
        (* 0.5 bilichi)
        (* 0.5 bilichi)
        "0"
      )
;;;      注记点及高程
      (if pth1
(progn
   (setq pth2 (RTOS pth1 2 2))
   (setq zjd1 (list (+ (+ ptx1 2) (* bilichi 2))
      (+ pty1 (* 3.0 bilichi))
       )
   )
   (setq zjd2 (list (+ (+ ptx1 2) (* bilichi 2))
      (+ pty1 (* 0 bilichi))
       )
   )
   (setq hxd1 (list (+ (+ ptx1 1) (* bilichi 0))
      (+ pty1 (* 1.5 bilichi))
       )
   )
   (setq hxd2 (list (+ (+ ptx1 5) (* bilichi 2))
      (+ pty1 (* 1.5 bilichi))
       )
   )
   (command "_line" hxd1 hxd2 "")
   (setq ent1 (entlast))
   (vl-cmdf "change" ent1 "" "p" "la" "999" "")
   (command "_text" "j" "mc" zjd1 "0" pn2)
   (setq ent1 (entlast))
   (vl-cmdf "change" ent1 "" "p" "la" "999" "")
   (command "_text" "j" "mc" zjd2 "0" pth2)
)
(progn
   (setq zjd1 (list (+ (+ ptx1 1) (* bilichi 2))
      (+ pty1 (* 0 bilichi))
       )
   )
   (command "_text" "j" "mc" zjd1 "0" pn2)
)
      )
    )
;;;end progn
    (setq ii (+ ii 1))
    (princ
      (strcat "\n正在展第" (itoa ii) "个点，请稍候.........:")
    )
;;;    (vl-cmdf "pline" Pt1)
  )
;;;  (vl-cmdf "pline" "")
;;;end while
  (CLOSE FIL1)
  (setvar "osmode" os)
  (setvar "cmdecho" od)
  (princ (strcat "\n共" (itoa ii) "个点已展点成功！"))
  (princ "\n OK!")
  (princ)
)

newer

楼主，能否把展点需要的数据文件弄个简单的例子传到论坛？

yoyoho

感谢 王子 分享程序!!!!

xvjiex

感谢分享展点程序