[求助] 会编程的进来看看

wowan1314

有个LSP程序在线上标字！但是标注的字离线太远了点！ 请帮忙修改下！与线的距离缩短到一半就好了！

(prompt "\n\n***欢迎使用水流畅制作的小工具***")
(prompt "\n\n***命令:DN***")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dxf (code elist)
  (cdr (assoc code elist)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dn (/ cmd_old os_old ss ss1 ss2 pt pt0 pt1 pt2 ang dn dn0 bdn_er bdn_oe)
  (setq cmd_old (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq os_old (getvar "osmode"))
  (setvar "osmode" 0)
;;
   (command "style" "ly1" "ly1,ly11" "0" "0.7" "0" "" "" "")
   (setvar "textsize" 300)
;;
  (defun bdn_er (s)   ; If an error (such as ESC) occurs
     ; while this command is active...
    (if (/= msg "功能取消")
      (if (= msg "退出 / 中止")
 (princ)
 (princ (strcat "\n功能取消!"))
      )
    )
    (eval (read U:E))
    (if bdn_oe    ; If an old error routine exists
      (setq *error* bdn_oe)  ; then, reset it
    )
    (if temp
      (redraw temp 1)
    )
    (princ)
  )
  (if *error*    ; Set our new error handler
    (setq bdn_oe  *error*
   *error* bdn_er
    )
    (setq *error* bdn_er)
  )

  ;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E))
  (setq U:G "(command \"undo\" \"group\")"
 U:E "(command \"undo\" \"en\")"
  )
(while
  (setq ss (entsel "\n请拾取需标注管径的管道<回车退出>:"))
  (menucmd "P0=DN.p02")
  (menucmd "P0=*")
  (setq ss1 (entget (car ss)))
  (setq ss2 (dxf 0 ss1))
  (setq pt (car (cdr ss)))
  (setq pt (osnap pt "NEA"))
  (cond
    ((= ss2 "LINE")

     (setq pt1 (dxf 10 ss1)
    pt2 (dxf 11 ss1)
     )
      (setq ang0 (angle pt1 pt2))
      (if
          (and (> ang0 (* PI 0.5)) (<= ang0 (* PI 1.5)))
          (setq ang0 (+ ang0 PI))
      )
      (setq ang (+ ang0 (* PI 0.5)))
      (setq pt0 (polar pt ang (* (getvar "textsize") 10)))
      (setq pt (inters pt1 pt2 pt0 pt nil))
      (setq pt (polar pt ang (* (getvar "textsize") 0.35)))      
      (setq dn0 "15")
      (setq dn (getstring (strcat "\n请输入该管道管径<" dn0 ">:")))
    (if
      (= dn "")
      (setq dn dn0)
      (setq dn0 dn)
    )
      (setq dn (strcat "DN" dn))
      (command "_.text" "C" pt (getvar "textsize") (angtos ang0 0 3) dn)
  )     ;cond1

  ((= ss2 "LWPOLYLINE")
        (setq ss1 (member (assoc 10 ss1) ss1))
        (setq pt1 (dxf 10 ss1))

        (setq r 1)
    (while r
        (setq ss1 (cdr ss1)
              ss1 (member (assoc 10 ss1) ss1)
              pt2 (dxf 10 ss1)
        )

        (setq dt1 (distance pt1 pt)
              dt2 (distance pt pt2)
              dt1 (+ dt1 dt2)
              dt1 (rtos dt1 2 1)
              dt1 (distof dt1 2)
              dt2 (distance pt1 pt2)
              dt2 (rtos dt2 2 1)
              dt2 (distof dt2 2)
        )

       (if (= dt1 dt2)
           (setq r nil)
           (setq pt1 pt2)
       )
     )    ;end while
          (setq ang0 (angle pt1 pt2))
      (if
          (and (> ang0 (* PI 0.5)) (<= ang0 (* PI 1.5)))
          (setq ang0 (+ ang0 PI))
      )
      (setq ang (+ ang0 (* PI 0.5)))
      (setq pt0 (polar pt ang (* (getvar "textsize") 2)))
      (setq pt (inters pt1 pt2 pt0 pt nil))
      (setq pt (polar pt ang (* (getvar "textsize") 0.4)))      
      (setq dn0 "15")
      (setq dn (getstring (strcat "\n请输入该管道管径<" dn0 ">:")))
    (if
      (= dn "")
      (setq dn dn0)
      (setq dn0 dn)
    )
      (setq dn (strcat "DN" dn))
      (command "_.text" "C" pt (getvar "textsize") (angtos ang0 0 3) dn)

  )     ;cond2
  (T
      (alert "\n所选图元不能进行管径标注!重新选取")
  )     ;T
)     ;cond
)                                       ;while
(setvar "cmdecho" cmd_old)
(setvar "osmode" os_old)
(princ)
);end of defun

yoyoho

不太懂你的意思,先下載研究研究.感謝你!

ZZXXQQ

改了改，加入了字线间距和字高的输入。

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

gghpoc

(setq pt0 (polar pt ang (* (getvar "textsize") 2)))
      (setq pt (inters pt1 pt2 pt0 pt nil))
      (setq pt (polar pt ang (* (getvar "textsize") 0.4)))  
将其中2及0.4修改较小数值即可