请教高手 水深点变成海图水深

song宋_74729

謝謝大哥 感恩

hunkmax

在明经学到了好多，试着写写，回报下论坛，也顺便练练手
(defun c:tt( / ss1 ss2 ss3 )
  (setq ss1 (ssget '((0 . "INSERT"))))
  (setq ss2 (ss->lst ss1))
  (repeat (length ss2)
          (progn (setq ss3 (car ss2))
                 (INSERT->STR ss3)
                 (entdel ss3)
                 (setq ss2 (cdr ss2))
          )
  )
  (princ)
)
;;;;选择集转表   
(defun ss->lst (ss / e i)
  (setq i 0 sslst '(""))
  (while (setq e (ssname ss i))
    (setq sslst (cons e sslst))
    (setq i (1+ i))
  )
  (cdr (reverse sslst))
)
;;;;单个块处理
(defun INSERT->STR (ss4 / dxf d1 d2 ent p1 p2 p3 )
  (setq dxf (entnext ss4)
        dxf (entget dxf)
        dxf (str->list (cdr (assoc 1 dxf)))
        d1  (car  dxf)
        d2  (cadr dxf)
        ent (entget ss4)
        p1  (cdr (assoc 10 ent))
        p2  (polar p1 2.670123 1)
        p3  (polar p1 -0.47147 1)
  )
  (entmake (list '(0 . "TEXT")  (cons 1 d1) (cons 10 p2) (cons 40 2);修改此处改字高，此时自高为2  
           '(51 . 0.261799)  '(41 . 0.75) ))
  (entmake (list '(0 . "TEXT")  (cons 1 d2) (cons 10 p3) (cons 40 1.5);修改此处改字高，此时自高为1.5  
           '(51 . 0.261799)  '(41 . 0.75) ))
  (princ)
)
;;;;提取字符串中的数字转化为实数表
(defun str->list (str / i ls lst st )
  (setq ls '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
  (setq i 1  lst '(" ") )
  (repeat (strlen str)
      (cond ((/= (member (setq st (substr str i 1)) ls) nil) (setq lst (cons st lst)))
            (T (setq lst lst))
      )
      (setq i (1+ i))
  )
  (cdr (reverse lst))
)

song宋_74729

hunkmax 发表于 2016-2-23 00:56
在明经学到了好多，试着写写，回报下论坛，也顺便练练手
(defun c:tt( / ss1 ss2 ss3 )
  (setq ss1 (ssg ...

這程序寫的不錯,但是如遇二位數 例如10以上就不行,還有小數點第一位數字可以另設一個圖層嗎

hunkmax

song宋_74729 发表于 2016-2-23 18:35
這程序寫的不錯,但是如遇二位數 例如10以上就不行,還有小數點第一位數字可以另設一個圖層嗎

帮你改了改哈
(defun c:tt( / ss1 ss2 ss3 )
  (setq ss1 (ssget '((0 . "INSERT"))))
  (setq ss2 (ss->lst ss1))
  (repeat (length ss2)
          (progn (setq ss3 (car ss2))
                 (INSERT->STR ss3)
                 (entdel ss3)
                 (setq ss2 (cdr ss2))
          )
  )
  (princ)
)

;;;;选择集转表   
(defun ss->lst (ss / e i)
  (setq i 0 sslst '(""))
  (while (setq e (ssname ss i))
    (setq sslst (cons e sslst))
    (setq i (1+ i))
  )
  (cdr (reverse sslst))
)

;;;;单个块处理
(defun INSERT->STR (ss4 / dxf d1 d2 ent p1 p2 p3 )
  (setq dxf (entnext ss4)
        dxf (entget dxf)
        dxf (cdr (assoc 1 dxf))
        d1  (rtos (fix (atof dxf)) 2 0)
        d2  (rtos (atof (substr (rtos (- (atof dxf) (fix  (atof dxf))) 2 1 ;修改此处改保留小数后几位，此时小数位数为1;
             ) 3)) 2 0)
        ent (entget ss4)
        p1  (cdr (assoc 10 ent))
        p2  (polar p1 2.670123 1)
        p3  (polar p1 -0.47147 1)
  )
  (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0)
                                                 (cons 2 "整数")));修改此处改新建图层名
  (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0)
                                                 (cons 2 "浮点数")));修改此处改新建图层名

  (entmake (list '(0 . "TEXT")  (cons 1 d1) (cons 10 p2) (cons 40 2);修改此处改字高，此时字高为2  
           '(51 . 0.261799)  '(41 . 0.75) (cons 8 "整数")   ))
  (entmake (list '(0 . "TEXT")  (cons 1 d2) (cons 10 p3) (cons 40 1.5);修改此处改字高，此时字高为1.5  
           '(51 . 0.261799)  '(41 . 0.75) (cons 8 "浮点数") ))
  (princ)
)

song宋_74729

兩位數跟小數點第一位 位置太近能夠再修正嗎謝謝

hunkmax

song宋_74729 发表于 2016-2-24 21:15
兩位數跟小數點第一位 位置太近能夠再修正嗎謝謝

p2  (polar p1 2.670123 1)
p3  (polar p1 -0.47147 1)
2.670123 是文字插入点的角度 ，1 是文字插入点的偏离距离，试试修改偏离距离，就好了

song宋_74729

hunkmax 发表于 2016-2-24 22:46
p2  (polar p1 2.670123 1)
p3  (polar p1 -0.47147 1)
2.670123 是文字插入点的角度 ，1 是文字插入点 ...

謝謝指點 還有一事請教 如果前有負號 如-10.3 就會變成-10.1怎麼解決呢

hunkmax

song宋_74729 发表于 2016-2-24 23:19
謝謝指點 還有一事請教 如果前有負號 如-10.3 就會變成-10.1怎麼解決呢

没考虑到的说， 修改一下d2的定义就好了
d2  (rtos (atof (substr (rtos (- (atof dxf) (fix  (atof dxf))) 2 1 ;修改此处改保留小数后几位，此时小数位数为1;
             ) (cond ((= "-" (substr d1 1 1)) 4)  (T 3)))) 2 0)

song宋_74729

hunkmax 发表于 2016-2-25 01:41
没考虑到的说， 修改一下d2的定义就好了
d2  (rtos (atof (substr (rtos (- (atof dxf) (fix  (atof dxf ...

變成全部都是-10.0煩請幫忙修正 謝謝