[求助感谢danxingpen,已完成更改坐标标注程序
 

[求助感谢danxingpen,已完成更改坐标标注程序
www.dimcax.com
[求助感谢danxingpen,已完成更改坐标标注程序
朋友，本人电脑崩溃，该坐标标注程序丢失，你那里是否有备份呀
另外哪位朋友下载了,能否提供该坐标标注程序(改写后的)
原本程序在3楼
谢谢
d
请使用winrar软件打开rar压缩文件。
传了一个。
danxingpen朋友的方法思路好像是利用while if判断"osmode"
4271,然后循环执行，
大家能帮我解决这个问题吗
谢谢
d
早上再顶一次
要求输入1次比例，然后即可多点随意标注坐标，直至结束
原程序在3楼
d
我从来不用坐标标注的，以前的那个帖子怎么删除了？我灌水？？？怀疑中！
改为如下程序即可
(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请输入打印的比例<默认为1>:"))
(if (= blx nil)(setq blx 1.0))
(setvar "dimzin" 1)
(setq blc (/ blx ))
(while (and (setvar "osmode" 4271)
(setq pt (getpoint "\n拾取需要标注的点:"))
(setq pt1(getpoint pt "\n拾取标注线起点:"))
)
(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 "")
(command "_style" "standard" "txt" "0" "1" "0" "n" "n" "")
(setvar "textstyle" "standard")
;请注意以下两行
(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)
)