香田里浪人 发表于 2013-2-4 14:41:38

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

原程序如下：
(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】 发表于 2013-2-4 15:57:26

(defun c:bcplbz ( / ang hh i pt1 pt2 ptlst pt-tx s1 sc ss tx)
(cmdlasc0)
(setq hh (getdist "文字高度:")
       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 hh ang tx)
        )
      )
    )
)
(cmdla1)
)

香田里浪人 发表于 2013-2-4 16:49:20

【KAIXIN】 发表于 2013-2-4 15:57 static/image/common/back.gif


好像无法运行

【KAIXIN】 发表于 2013-2-4 16:56:08

香田里浪人 发表于 2013-2-4 16:49 static/image/common/back.gif
好像无法运行

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

香田里浪人 发表于 2013-2-4 20:32:04

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

注册 发表于 2013-5-25 20:35:22

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

是的，同样的问题

q3_2006 发表于 2013-6-4 07:50:07

都不能用！

hehaidizhi 发表于 2013-6-23 17:46:35

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

香田里浪人 发表于 2013-6-23 19:30:03

hehaidizhi 发表于 2013-6-23 17:46 static/image/common/back.gif
楼主放出来的程序，运行命令是什么？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 发表于 2013-6-23 20:12:39

OK，试一下，谢谢啊
页: [1] 2
查看完整版本: 批量标注多线段长度程序修改