批量标注多线段长度程序修改

香田里浪人

原程序如下：
(defun c:bcplbz ()
  (CMDLASC0)
(setq ss (ssget '((0 . "*LINE")))
i  -1
  )
(mkla "线长标注" 4)
(while (setq s1 (ssname ss (setq i (1+ i))))
   (setq ptlst (uptlst s1))
    (while (setq pt1 (car ptlst))
      (if (setq ptlst (cdr ptlst))
(progn
   (setq pt2   (car ptlst)
  tx    (rtos (distance pt1 pt2) 2 2)
  ang   (rad2ang (angle pt1 pt2))
  pt-tx (PT-RIGHT pt1 pt2 (* sc 100))
   )
   (command "text" "j" "BC" pt-tx (* sc 50) ang tx)
)
      )
    )
  )
(CMDLA1)
)
要求自定义标注的字体大小，该怎么修改

【KAIXIN】

2. (defun c:bcplbz ( / ang hh i pt1 pt2 ptlst pt-tx s1 sc ss tx)
   
3.   (cmdlasc0)
   
4.   (setq hh (getdist "文字高度:")
   
5.        ss (ssget '((0 . "*LINE")))
   
6.         i -1
   
7.   )
   
8.   (mkla "线长标注" 4)
   
9.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
10.     (setq ptlst (uptlst s1))
    
11.     (while (setq pt1 (car ptlst))
    
12.       (if (setq ptlst (cdr ptlst))
    
13.         (progn
    
14.           (setq pt2 (car ptlst)
    
15.                 tx (rtos (distance pt1 pt2) 2 2)
    
16.                 ang (rad2ang (angle pt1 pt2))
    
17.                 pt-tx (pt-right pt1 pt2 (* sc 100))
    
18.           )
    
19.           (command "text" "j" "BC" pt-tx hh ang tx)
    
20.         )
    
21.       )
    
22.     )
    
23.   )
    
24.   (cmdla1)
    
25. )
    
26. 
    

(defun c:bcplbz ( / ang hh i pt1 pt2 ptlst pt-tx s1 sc ss tx)<br />   (cmdlasc0)<br />   (setq hh (getdist "文字高度:")<br />        ss (ssget '((0 . "*LINE")))<br />         i -1<br />   )<br />   (mkla "线长标注" 4)<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq ptlst (uptlst s1))<br />     (while (setq pt1 (car ptlst))<br />       (if (setq ptlst (cdr ptlst))<br />         (progn<br />           (setq pt2 (car ptlst)<br />                 tx (rtos (distance pt1 pt2) 2 2)<br />                 ang (rad2ang (angle pt1 pt2))<br />                 pt-tx (pt-right pt1 pt2 (* sc 100))<br />           )<br />           (command "text" "j" "BC" pt-tx hh ang tx)<br />         )<br />       )<br />     )<br />   )<br />   (cmdla1)<br /> )<br /> <br />

香田里浪人

【KAIXIN】 发表于 2013-2-4 15:57

好像无法运行

【KAIXIN】

香田里浪人 发表于 2013-2-4 16:49
好像无法运行

这个是你自己的源程序，
那么多的自定义函数，如果没有这些自定义函数，又怎么能用呢？

香田里浪人

原程序可运行，可是按老兄的方法修改后无法运行。

注册

香田里浪人 发表于 2013-2-4 20:32
原程序可运行，可是按老兄的方法修改后无法运行。

是的，同样的问题

q3_2006

都不能用！

hehaidizhi

楼主放出来的程序，运行命令是什么？bcplbz？加载后无法运行啊

香田里浪人

hehaidizhi 发表于 2013-6-23 17:46
楼主放出来的程序，运行命令是什么？bcplbz？加载后无法运行啊

试试这个：
(defun c:bcplbz ()
  (CMDLASC0)
(setq ss (ssget '((0 . "*LINE")))
i  -1
  )
(command "layer" "M" "长度标注" "C" "4" "" "LT" "CONTINUOUS" "" "");设置一个标注图层
(command "style" "Style1" "仿宋_GB2312" "" "1.0" "0" "N" "N")
(defun maketext (txt pt)             ; 生成文字子函数
    (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 40 TextHeight) (cons 1 txt) '(41 . 0.8)'(7 . "宋体")))
  )
(while (setq s1 (ssname ss (setq i (1+ i))))
   (setq ptlst (uptlst s1))
    (while (setq pt1 (car ptlst))
      (if (setq ptlst (cdr ptlst))
(progn
   (setq pt2   (car ptlst)
  tx    (rtos (distance pt1 pt2) 2 2)
  ang   (rad2ang (angle pt1 pt2))
  pt-tx (PT-RIGHT pt1 pt2 (* sc 100))
   )
   (command "text" "j" "BC" pt-tx (* sc 100) ang tx)
)
      )
    )
  )
(CMDLA1)
)

hehaidizhi

OK，试一下，谢谢啊