请大神帮我解决一下这个画梁线lsp的bug

kb2481

这是明经上找的一个画梁线的lsp，有点bug，请大神帮忙解决一下：
1、在新建的空白图纸里执行就会出现
** Error: AutoCAD 变量设置被拒绝: "textstyle" "G_hy_text" **
2、新建一个空白图纸，把梁线和文字图层拷过来，然后执行，就会出现下图的提示，然后画不出线。 但是在有的图里又可以正常画，不知道是怎么回事。
3、可以正常执行的情况下，文字在梁线上方，而且不在梁线的中间，怎么把文字弄到梁线下面又居中？


源码如下：
(defun C:bb(/ R1 K2 laysn STS LKK LGG PC1 PC2 JD0 J0 JD1 PZ2 PZD LKS K3 PX1 PT1 PT2 L1 PT3 PT4)
   (defun *error* (msg)
    (setvar "CMDECHO" 0)               ; 还原系统变量
    (command-s ".UNDO" "E")
    (or
      (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **"))
    )
    (princ)
  )
  (setq laysn (getvar "clayer"))


  (setq b (tblsearch "STYLE" "G_hy_text"));;搜索是否已有目标样式
  (if (= b nil);;如果没有目标图层则新建该样式
      (command "-STYLE" "G_hy_text" "_hysz.shx,_hyfs.shx" "0" "0.7" "0" "N" "N" "N")
)

  (setq b(tblsearch "LAYER" "G_BEAM_IN（梁虚线）"));;搜索是否已有目标图层
  (if (= b nil);;如果没有目标图层则新建该图层
      (command-s "-layer" "n" "G_BEAM_IN（梁虚线）" "c" 7 ""  "L" "_HY_DASHED100" "" "")
)
  (setq b(tblsearch "LAYER" "G_BEAM_TEXT（梁截面文字）"));;搜索是否已有目标图层
  (if (= b nil);;如果没有目标图层则新建该图层
      (command-s "-layer" "m" "G_BEAM_TEXT（梁截面文字）" "c" 2 "" "")
)

  (setq r1 (getvar "userr1"))
  (setq k1  (* 250 (/ r1 100)))
  (setq k2 (* 100 (/ r1 100)))
  (if (or (= str nil) (= (wcmatch str "*.*") nil)) (setq str "200.400"))
  (if (= ssdq nil) (setq ssdq "C" DQWZ "居中"))
  (setq stt str)
  (setq TFF 0)
  (while (= TFF 0)
          (if (or (= str nil) (= (wcmatch str "*.*") nil)) (setq str stt))
          ;(if (or (= str nil) (= (wcmatch str "*.*") nil)) (setq str "200.400"))
          ;(setq stt str)
          (setq str (getstring (strcat "\n输入梁截面(*.*)or[上对齐(F)/居中(C)/下对齐(B)]当前{" DQWZ "}:<" stt ">:")))
          (if (= str "")
            (setq str stt)
            (if (not(wcmatch str "*.*"))
                    (setq ssdq (strcase str) DQWZ (if (= ssdq "F") "上对齐" (if (= ssdq "C") "居中" "下对齐")))
            )
          )
          (setq sts (vl-string-subst "X" "." str))       
          (if (wcmatch str "*.*") (progn
                    (setq TFF 1)
                    (setq LKK (SB_LJM str 1))
                    (setq LGG (SB_LJM str 2))
                    (while (and (setq pc1 (getpoint "\n请输入第一点:"))
                            (setq pc2 (getpoint  pc1 "\n请输入第二点:")))
                            (setvar "CLAYER" "G_BEAM_IN（梁虚线）")
                            (setq jd0 (JD_PP pc1 pc2))
                            (setq j0 (angtos jd0 0 20))
                            (setq jd1 (+ jd0 (/ pi 2)))
                            (setq pz2 (mapcar '+ pc1 pc2))
                            (setq pzd (mapcar  '(lambda (x) (/ x 2)) pz2) )
                            (if (= DQWZ "上对齐") (setq lks 0 ))
                            (if (= DQWZ "居中")   (setq lks 0.5))
                            (if (= DQWZ "下对齐") (setq lks 1))
                            (setq k3 (+ (* LKK lks) k2))
                            (setq px1 (polar pzd jd1 k3))
                            (setvar "clayer" "G_BEAM_TEXT（梁截面文字）")
                            (command-s "text" "style" "G_hy_text" "G_hy_text" px1 k1 j0 sts)
                            ;(command-s "text" "G_hy_text" px1 k1 j0 sts)
                            (setvar "clayer" "G_BEAM_IN（梁虚线）")                        
                            (if (= ssdq "F") (progn
                                      (setq TFF 0)
                                      (command-s "line" pc1 pc2 "")
                                      (setq pt1 (polar pc1 (+ jd0 (* 1.5 pi)) LKK))
                                      (setq pt2 (polar pc2 (+ jd0 (* 1.5 pi)) LKK))
                                      (command-s "line" pt1 pt2 "")
                            ))
                            (if (= ssdq "C") (progn
                                      ;(setvar "CLAYER" "S10-ASSIST-AXIS")
                                      ;(command-s "line" pc1 pc2 "")
                                      (setvar "clayer" "G_BEAM_IN（梁虚线）")
                                      (setq TFF 0)
                                      (setq l1 (/ LKK 2))
                                      (setq pt1 (polar pc1 (+ jd0 (* 1.5 pi)) l1))
                                      (setq pt2 (polar pc2 (+ jd0 (* 1.5 pi)) l1))
                                      (command-s "line" pt1 pt2 "")
                                      (setq pt3 (polar pc1 (+ jd0 (* 0.5 pi)) l1))
                                      (setq pt4 (polar pc2 (+ jd0 (* 0.5 pi)) l1))
                                      (command-s "line" pt3 pt4 "")
                            ))
                            (if (= ssdq "B") (progn
                                      (setq TFF 0)
                                      (command-s "line" pc1 pc2 "")
                                      (setq pt1 (polar pc1 (+ jd0 (* 0.5 pi)) LKK))
                                      (setq pt2 (polar pc2 (+ jd0 (* 0.5 pi)) LKK))
                                      (command-s "line" pt1 pt2 "")
                            ))
                    )
          ))
  )
  (setvar "clayer" laysn)
  (princ)
)
;;;(x)梁截面识别
(defun SB_LJM(LJM pr)        
  (VL-LOAD-COM)
  (setq LKST "")
  (setq LGST "")
  (setq LJMN (strlen LJM))
  (if (wcmatch LJM "*.*") (progn
                  (setq XDWZ (vl-string-search  "." LJM))   ;;;小数点位置
                  (setq LKFF (atof (substr LJM 1 XDWZ)))    ;;;梁宽实数
                  (setq LGFF (atof (substr LJM (+ XDWZ 2))));;;梁高实数
  ))
  (if (= pr 1)
          (setq LKLG LKFF)
          (setq LKLG LGFF)
  )
  LKLG   
)


;;;  根据两点求角度
(defun JD_PP(pd0 pdt)
        (setq adt (car  pdt))
        (setq bdt (cadr pdt))
       
        (setq ad0 (car  pd0))
        (setq bd0 (cadr pd0))
       
        (setq lda (- adt ad0))
        (setq ldb (- bdt bd0))
       
        (if (/= lda 0)
                (setq JDD (atan (/ ldb lda)))
                (setq JDD (/ pi 2)))
        JDD
)

xvjiex

帮你改了一下。
已经更新！
文字往下调了一点。
文字与线间距已经按新的要求调到100
线型已经调整为_HY_DASHED100，测试图纸2里面文字到直线的距离也搞定了，是文档问题。
已经查出原因，在线型_HY_DASHED100前面不小心留了一个空格。

kb2481

xvjiex 发表于 2020-7-13 11:22
帮你改了一下。

多谢大神，文字居中了，但是还有两个问题。一个是新建一张白图，再运行lsp的话会出现如下提示，不知道你是否也出现这种情况？

还有就是文字的高度出来的是200高，怎么改成250高，宽度因子1.0怎么改成0.7？

xvjiex

已经按您的要求调整，请重新测试！

kb2481

xvjiex 发表于 2020-7-14 09:28
已经按您的要求调整，请重新测试！

在新建的空白图纸内文字到梁线的间距不正常，在有的图纸里又是正常的，是什么原因呢？

xvjiex

请把您的这个文档上传，我来看看。

kb2481

xvjiex 发表于 2020-7-14 21:21
请把您的这个文档上传，我来看看。

这里，CAD2012新建的空白图纸

xvjiex

您的文档可能是网络原因，我下载后打不开，也无法修复。用CAD看图软件也打不开。

所以，无法知道您新建的文档是采用什么模板新建的。现在我只能先将文字往下调一点，两者兼顾。您可以重新试一下，这样往下调是否合适。

kb2481

xvjiex 发表于 2020-7-15 09:06
您的文档可能是网络原因，我下载后打不开，也无法修复。用CAD看图软件也打不开。

所以，无法知道您新建 ...

应该可以了，你看下能否打开，在这两张图里文字到直线的距离是不一样

xvjiex

gbenor.shx，gbcbig.shx这两个字库是最常用的，没想到你也没有。请将压缩包解压，把文件放到CAD安装目录下有个Fonts目录下面。