多段线各端点批量标注坐标并编号然后把各点坐标导出到文本上

88641787

多段线各端点标注坐标并编号然后把各点坐标导出到文本上        

香田里浪人

  ;;;多段线坐标标注并导出
(defun c:zbbzdc()
   (setq ps_cmdecho (getvar "cmdecho")
         ps_osmode  (getvar "osmode")
         ps_luprec  (getvar "luprec")   
     )
     (setvar "cmdecho" 0)
     (setvar "osmode" 0)
     (setvar "luprec" 0)
(setq TextHeight (getdist "\n请输入文字高度:"))
     (command "-layer" "n" "坐标标注" "c" "4" "坐标标注" "")
      (setvar"dimzin"0);;保留小数位数时如果位数不足可以补零     
     (princ "\n输入引线长度 (建议")(princ (* TextHeight 10))(princ ")")
     (princ "<上次长度为")(princ long)(princ ">:")
     (setq long (getreal))
     (setq sunmer (ssget '((-4 . "<OR")
                           (0 . "POLYLINE")
                           (0 . "LWPOLYLINE")
                           (-4 . "OR>")
                          )
                   )
     )
     (setq germeip (sslength sunmer))
      (setq pianju (* TextHeight 0.1))
     (setq somode 0)
     (while (< somode germeip)
        (setq limes (entget (ssname sunmer somode)))
        (setq limun (length limes))
        (setq aobel 0)
        (while (< aobel limun)
          (if (= (car (nth aobel limes)) 10)
            (progn
               (command "layer" "s" "坐标标注" "")
               (setq pt (cdr (nth aobel limes)))
               (setq pt1 (polar pt (+ 0 (* 0.4 pi)) long))
               (setq pt2 (polar pt1 0 (* TextHeight 7.5)))
               (command "line" pt pt1 pt2 "")
               (setq xx (strcat "Y=" (rtos (car pt) 2 3)))
               (setq yy (strcat "X=" (rtos (cadr pt) 2 3)))            
               (setq ptx (list (+ (car pt1) 0.1) (- (cadr pt1) TextHeight)))
               (setq pty (list (+ (car pt1) 0.1) (+ (cadr pt1) pianju)))
               (command "text" pty TextHeight 0 yy)
               (command "text" ptx TextHeight 0 xx)
            )
          )
          (setq aobel (1+ aobel))
        )
          (setq somode (1+ somode))
     )
(defun vxs (e / i v lst)
  (setq i -1)
  (while
    (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
     (setq lst (cons v lst))
  )
  (reverse lst)
)
(setq ss sunmer  i 0
        filex (getfiled "指定输出文件路径" "" "xls" 1)        file (open filex "w"))
  (repeat (sslength ss)
    (setq j 1  ent (entget (ssname ss i))  p (cdr (assoc 10 ent)))
    (write-line (strcat "线段" (itoa (1+ i))) file)
    (write-line "点号\tX\tY\tZ" file)
    (entmake (list '(0 . "TEXT") (cons 1 (strcat  (itoa (1+ i))"#线段")) (cons 10 (list (car p) (- (cadr p) TextHeight)))(cons 7 "宋体") (cons 40 TextHeight)))
    (while (setq p (assoc 10 ent))
      (setq ent (cdr (member p ent)) p (cdr p))
      (entmake (list '(0 . "TEXT") (cons 1 (itoa j)) (cons 10 (list (+ (car p) 0.01) (- (cadr p) 0.01)))(cons 7 "宋体") (cons 40 TextHeight)(cons 8 "编号")(cons 62 3) ))
      (write-line (strcat (itoa j) "\t" (rtos (cadr p) 2 3) "\t" (rtos (car p) 2 3) "\t"
                          (if (caddr p) (rtos (caddr p) 2 3)"0.0")) file )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
  (close file)
   (princ)
)

sicky111

一个求助帖，标题怎么写[源码]？

ludaweb

zzyong00

标注坐标引线都是一个方向，楼主的标注都向“外”

88641787

zzyong00 发表于 2015-12-29 20:05
标注坐标引线都是一个方向，楼主的标注都向“外”

一个在左一个在右   要不就是一个在上一个在下

88641787

香田里浪人 发表于 2015-12-29 21:13
;;;多段线坐标标注并导出
(defun c:zbbzbdc()
   (setq ps_cmdecho (getvar "cmdecho")

你好版主     这个只是标注坐标   没有标注序号    也没有把坐标导出至记事本里  

88641787

88641787 发表于 2015-12-29 21:44
一个在左一个在右   要不就是一个在上一个在下

其实图片上那种效果已经很好了

香田里浪人

88641787 发表于 2015-12-29 21:46
你好版主     这个只是标注坐标   没有标注序号    也没有把坐标导出至记事本里

我不是版主，88641787先生，五楼程序已经修改，这下应该可以用了

香田里浪人

5楼程序可以满足楼主要求。