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

wowan1314 发表于 2007-11-7 19:59:00

有个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 发表于 2007-11-13 00:42:00

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

ZZXXQQ 发表于 2007-11-20 16:05:00

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

(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\")"
)
(SETQ OLDGAP (GETVAR "DIMGAP"))
(SETQ OLDTH (GETVAR "TEXTSIZE"))
(SETQ GAP (GETDIST (STRCAT "\n输入字线间距 <" (GETVAR "DIMGAP") "> :"))
 GAP (IF GAP GAP (GETVAR "DIMGAP")))
(SETVAR "DIMGAP" GAP)
(SETQ TXTH (GETDIST (STRCAT "\n输入字高 <" (GETVAR "TEXTSIZE") "> :"))
 TXTH (IF TXTH TXTH (GETVAR "TEXTSIZE")))
(SETVAR "TEXTSIZE" TXTH)
(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 "DIMGAP")))
(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 "DIMGAP")))
(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所选图元不能进行管径标注!重新选取"))
) ;cond
);while
(SETVAR "DIMGAP" OLDGAP)
(SETVAR "TEXTSIZE" OLDTH)
(setvar "cmdecho" cmd_old)
(setvar "osmode" os_old)
(princ)
);end of defun

gghpoc 发表于 2008-1-3 20:28:00

(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修改较小数值即可

页: [1]

明经CAD社区's Archiver

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