坐标标注LISP代码

newer · 发表于 2016-4-13 12:42:41

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

虽然和晓东工具箱里面的坐标标注功能差很远，但也可以对学LISP的童鞋有帮助。

(defun C:zb (/ zb gd cld osm)
(setq osm (getvar "osmode"))
(setvar "osmode" 33)
(command "layer" "m" "zbzj" "")
(setq gd (getreal "指定标注文字高度:>"))
(if (= gd nil)
(setq gd 0.5)
)
(while (setq zb (getpoint "指定坐标点："))
(setq cld (getpoint zb "指定文字插入点："))
(entmake (list '(0 . "LINE") '(67 . 0) '(8 . "0") (list 10 (car zb)
(cadr zb) 0
) (list 11
(car cld)
(cadr cld) 0
) '(210 0.0 0.0 1.0)
)
)
(entmake (list '(0 . "text") (list 10 (+ (car cld) gd) (car
(cdr cld)
)
) (cons 40 gd) (cons 1 (strcat "X="
(rtos
(cadr zb)
2 3
)
)
) '(50 . 0)
)
)
(entmake (list '(0 . "text") (list 10 (+ (car cld) gd) (- (car
(cdr cld)
) (+ gd
(/ gd 3)
)
)
) (cons 40 gd) (cons 1 (strcat "Y="
(rtos
(car zb)
2 3
)
)
) '(50 . 0)
)
)
)
(setvar "osmode" osm)
(princ)
)

(defun C:zb (/ zb gd cld osm) 
  (setq osm (getvar "osmode")) 
  (setvar "osmode" 33) 
  (command "layer" "m" "zbzj" "") 
  (setq gd (getreal "指定标注文字高度:>")) 
  (if (= gd nil) 
    (setq gd 0.5) 
  ) 
 
  (while (setq zb (getpoint "指定坐标点：")) 
 
    (setq cld (getpoint zb "指定文字插入点：")) 
 
    (entmake (list '(0 . "LINE") '(67 . 0) '(8 . "0") (list 10 (car zb) 
                                                            (cadr zb) 0 
                                                      ) (list 11 
                                                              (car cld) 
                                                              (cadr cld) 0 
                                                        ) '(210 0.0 0.0 1.0) 
             ) 
    ) 
    (entmake (list '(0 . "text") (list 10 (+ (car cld) gd) (car 
                                                                (cdr cld) 
                                                           ) 
                                 ) (cons 40 gd) (cons 1 (strcat "X=" 
                                                                (rtos 
                                                                      (cadr zb) 
                                                                      2 3 
                                                                ) 
                                                        ) 
                                                ) '(50 . 0) 
             ) 
    ) 
    (entmake (list '(0 . "text") (list 10 (+ (car cld) gd) (- (car 
                                                                   (cdr cld) 
                                                              ) (+ gd 
                                                                   (/ gd 3) 
                                                                ) 
                                                           ) 
                                 ) (cons 40 gd) (cons 1 (strcat "Y=" 
                                                                (rtos 
                                                                      (car zb) 
                                                                      2 3 
                                                                ) 
                                                        ) 
                                                ) '(50 . 0) 
             ) 
    ) 
  ) 
 
  (setvar "osmode" osm) 
  (princ) 
 
)

skg123 · 发表于 2016-4-18 22:24:31

不是很好用

xvjiex · 发表于 2021-8-26 00:04:44

感谢楼主分享坐标标注LISP代码

账号		自动登录	找回密码
密码			立即注册

[每日一码] 坐标标注LISP代码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。