[文章]：标注尺寸lisp

xiaotang

谢谢yshf
我将变量bly删除了，只余blx一个变量，才出现了零长度直线，只是偶尔才出现，没有找到规律
命令: zz
请输入打印的比例<默认为500>:
拾取需要标注的点:
拾取标注线起点:

taner

請問PHP代碼和圖片是怎樣貼上去的?謝謝!

xiaotang

问题解决了，能够正常使用了，但今天又出现了一个问题，坐标标注时，显示的应该是X=***，Y=***，但等号无缘无故没有了，我把这句改为(setq y (strcat "Y=" (rtos (car pt) 2 3))
x (strcat "X=" (rtos (cadr pt) 2 3))，X、Y后各加了一个等号，一切正常了，不知这个原因是怎样产生的？我的解决方法是否正确？

yshf

你最早给出的程序为:
(command "text" "ml" (list xx2 (+ y1 2.625))  3.5 0 (strcat "X " (rtos x 2 3)))
(command "text" "ml" (list xx2 (- y1 2.625))  3.5 0 (strcat "Y " (rtos y 2 3)))
中就没有“=”号，怎么能说是“等号无缘无故没有了”。
你现在的解决方法是正确的，但是差了一个“)”。
(setq y (strcat "Y=" (rtos (car  pt) 2 3))
        x (strcat "X=" (rtos (cadr pt) 2 3))
)

xiaotang

可能是试验的次数多了，总是认为原先带等号的
现在根据自己的需要，更改了一下主要是删除了bly这个东西
程序如下，请指点，另外那个括号加上出现了问题，没有括号就正常了
(defun zz_err (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setvar "osmode" os)
(if dis (setvar "dimzin" dis))
(setvar "cmdecho" cmd)
(command "_.UNDO" "_E")
)

;;=============== Main program ============

(defun c:zz (/ cmd os pt x y pt1 x1 y1 xx2 pt2 dis)
(setq *error* zz_err)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 4271)

;请注以下三行
(command "_.undo" "be")
(setq blx (getreal "\n请输入打印的比例<默认为500>:")
pt (getpoint "\n拾取需要标注的点:")
pt1 (getpoint pt "\n拾取标注线起点:")
)

;请注意以下三行
(if (= blx nil)(setq blx 500.0))
(setq blc (/ blx ))

(setq y (strcat "Y=" (rtos (car pt) 2 3))
x (strcat "X=" (rtos (cadr pt) 2 3))
x1 (car pt1) y1 (cadr pt1)
y2 y1
dxy (textbox (list (cons 1 x) (cons 40 (* 3.5 blc))))
dl1 (car (mapcar '- (cadr dxy) (car dxy)))
dxy (textbox (list (cons 1 y) (cons 40 (* 3.5 blc))))
dl2 (car (mapcar '- (cadr dxy) (car dxy)))
ddd dl1
)
(if (> dl2 dl1) (setq ddd dl2))
(if (> x1 (car pt))
(setq x2 (+ x1 ddd 0.5) xx2 (+ x1 0.5))
(setq x2 (- x1 ddd 0.5) xx2 (+ x2 0.5))
)
(setvar "osmode" 0)
(setq pt2 (list x2 y2))
(command "line" pt pt1 pt2 "")
(if (null (setq elist (tblsearch "style" "S2")))
(command "_style" "S2" "S2.ttf" "0.0" "" "0.0" "" "")
)
(setvar "TEXTSTYLE" "S2")
(setq dis (getvar "dimzin"))
(setvar "dimzin" 1)

;请注意以下两行
(command "text" "ml" (list xx2 (+ y1 (* 2.625 blc))) (* 3.5 blc) 0 x)
(command "text" "ml" (list xx2 (- y1 (* 2.625 blc))) (* 3.5 blc) 0 y)

;请注意以下四行的顺序
(command "_.UNDO" "_E")
(setvar "osmode" os)
(setvar "dimzin" dis)
(setvar "cmdecho" cmd)
(princ)
)
补充一点，刚才发现了一个问题，坐标标注原先精度是小数点后三位，末尾数是零后，标注的数值自动删除了这个末尾数零，能否保留这个零呀，即小数点后永远是三位

yshf

;改为如下程序即可
(defun zz_err (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setvar "osmode" os)
(if dis (setvar "dimzin" dis))
(setvar "cmdecho" cmd)
(command "_.UNDO" "_E")
)

;;=============== Main program ============

(defun c:zz (/ cmd os pt x y pt1 x1 y1 xx2 pt2 dis)
(setq *error* zz_err)
(setq cmd (getvar "cmdecho") )
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setq dis (getvar "dimzin"))
(setvar "osmode" 4271)

;请注以下三行
(command "_.undo" "be")
(setq blx (getreal "\n请输入打印的比例<默认为500>:")
pt (getpoint "\n拾取需要标注的点:")
pt1 (getpoint pt "\n拾取标注线起点:")
)

;请注意以下三行
(if (= blx nil)(setq blx 500.0))
(setq blc (/ blx ))
(setvar "dimzin" 1)

(setq y (strcat "Y=" (rtos (car pt) 2 3))
x (strcat "X=" (rtos (cadr pt) 2 3))
x1 (car pt1) y1 (cadr pt1)
y2 y1
dxy (textbox (list (cons 1 x) (cons 40 (* 3.5 blc))))
dl1 (car (mapcar '- (cadr dxy) (car dxy)))
dxy (textbox (list (cons 1 y) (cons 40 (* 3.5 blc))))
dl2 (car (mapcar '- (cadr dxy) (car dxy)))
ddd dl1
)
(if (> dl2 dl1) (setq ddd dl2))
(if (> x1 (car pt))
(setq x2 (+ x1 ddd 0.5) xx2 (+ x1 0.5))
(setq x2 (- x1 ddd 0.5) xx2 (+ x2 0.5))
)
(setvar "osmode" 0)
(setq pt2 (list x2 y2))
(command "line" pt pt1 pt2 "")
(if (null (setq elist (tblsearch "style" "S2")))
(command "_style" "S2" "S2.ttf" "0.0" "" "0.0" "" "")
)
(setvar "TEXTSTYLE" "S2")



;请注意以下两行
(command "text" "ml" (list xx2 (+ y1 (* 2.625 blc))) (* 3.5 blc) 0 x)
(command "text" "ml" (list xx2 (- y1 (* 2.625 blc))) (* 3.5 blc) 0 y)

;请注意以下四行的顺序
(command "_.UNDO" "_E")
(setvar "osmode" os)
(setvar "dimzin" dis)
(setvar "cmdecho" cmd)
(princ)
)

xiaotang

万分感谢yshf，已经非常管用了，再问一个问题
就是新打开的文档中没有S2这种字体，若这时使用坐标标注，会出现错误的提示，不知道用什么方法解决？
我一般是复制一个S2格式的字体，粘贴到新建文档中，就可以正常使用了

yshf

将"S2.ttf"复制到"\Auto CAD XXX\fonts"中，或者另用其"ttf"它字体。

david96007

看看我以前的帖子有没有用?!


http://www.xdcad.net/forum/showthread.php?threadid=350253

xiaotang

最初由 yshf 发布
[B]将"S2.ttf"复制到"\Auto CAD XXX\fonts"中，或者另用其"ttf"它字体。 [/B]

请教如何进行，我的文字样式S2是通过设置文字样式进行得到的，在什么地方找到*.ttf格式？谢谢

yshf

将程序中"S2.ttf"改为"宋体"或者"黑体"等ttf字体。

xiaotang

楼主说的是图示这种字体格式吧

xiaotang

楼主说的是这种文字格式吧

xiaotang

我个文件夹中全部是SHX字体，没有TTF格式的字体