求助关于动态标注（grread）键盘输入值 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第3页

namezg 发表于 2018-7-27 08:53:54

本帖最后由 namezg 于 2018-7-27 09:00 编辑

;找到问题了，再试试
(defun pdjd (/ o1 o2 lst jd fx);(pdjd);判断角度
   (setq o1(cadr(grread 3))
            o2(cadr(grread 3))
   );光标位置
   (setq lst (view-ucs-box));屏幕左上、右下两对角点UCS
   (while (<(distance o1 o2)(*(distance(car lst)(cadr lst))0.008))
            (setq o2 (cadr (grread 3)));光标位置
            (setq lst (view-ucs-box))
   )
   (setq jd (/(*(angle o1 o2)180)pi));两点与X轴的角度
   (if (or (<= 45 jd 135) (<= 225 jd 315))
            (setq fx "V");垂直
            (setq fx "H");水平
   )
)
(defun c:66(/ p1 fx ss txt p2 p3) ;标线性、φ、M
(setvar "cmdecho" 0)
(if (setq p1 (getpoint "\n请指标注起点:"))
(progn
(setvar 'dimpost".");标注无前后缀
(command "dimlinear" "non" p1 "non" p1 (setq fx (pdjd)) "non" p1)
(ydd (entlast) 14 p1)
(setq ss (ssadd)
ss (ssadd (entlast) ss)
txt (cdr (assoc 42 (entget (ssname ss 0))))
)
(setq p2 (cadr (grread 3)))
(command "_.erase" (entlast) "")
(if (and (nentselp p1)(nentselp p2))
(progn
(setq p2 (osnap p2 "nea"))
(command "dimpost" "%%C<>" "dimlinear" "non" p1 "non" p2 fx "non" p1)
(princ (strcat "\n右键改为 M" (rtos txt 2 (getvar "dimdec"))))
(if (ydd (entlast) 10 p1)
(command "u" 1 "dimpost" "M<>" "dimlinear" "non" p1 "non" p2 fx "non" (cadr (grread 3)))
)
)
(progn
(command "u" 1)
(if (ydd (entlast) 10 p1)
(command "_.erase" (entlast) "")
)
)
)
)
)
(setvar 'dimpost".");标注无前后缀
(setvar "cmdecho" 1)
(princ)
)

669423907 发表于 2018-7-27 10:25:35

namezg 发表于 2018-7-27 08:53
;找到问题了，再试试
(defun pdjd (/ o1 o2 lst jd fx);(pdjd);判断角度
(setq o1(cadr(grread 3 ...

效果很好啊，非常感谢namezg大师，请问是改了哪里呢？

namezg 发表于 2018-7-27 11:32:19

;重新对代码进行了大量改动，应该比原来的好。

(defun pdjd (/ o1 o2 lst jd fx);(pdjd);判断角度
(setq o1(cadr(grread 3))
o2(cadr(grread 3))
);光标位置
(setq lst (view-ucs-box));屏幕左上、右下两对角点UCS
(while (<(distance o1 o2)(*(distance(car lst)(cadr lst))0.008))
(setq o2 (cadr (grread 3)));光标位置
(setq lst (view-ucs-box))
)
(setq jd (/(*(angle o1 o2)180)pi));两点与X轴的角度
(if (or (<= 45 jd 135) (<= 225 jd 315))
(setq fx "V");垂直
(setq fx "H");水平
)
)
(defun c:66(/ p1 fx en dxf txt p2) ;标线性、φ、M
(setvar "cmdecho" 0)
(if (setq p1 (getpoint "\n请指标注起点:"))
(progn
(setvar "dimpost" ".");标注无前后缀
(command "dimlinear" "non" p1 "non" p1 (setq fx (pdjd)) "non" p1)
(ydd (entlast) 14 p1)
(setq dxf (entget (setq en (entlast))))
(entdel en);(command "_.erase" en "")
(setq p2 (cadr (grread 3)))
(if (and (nentselp p1)(nentselp p2))
(progn
(setq en (entmakex dxf))
;方法1(文字替代)
;(command "dimedit" "n" "%%c<>" en "");可代替上面一行
;方法2(加前缀)
(setvar "dimpost" "%%c<>")
(command "dimstyle" "apply" en "")
(princ "\n当前前缀为%%c，右键可将前缀改为M。")
(if (ydd en 10 p1)
(progn
;方法1(文字替代)
;(command "dimedit" "n" "M<>" en "");可代替上面一行
;方法2(加前缀)
(setvar "dimpost" "M<>")
(command "dimstyle" "apply" en "")
)
)
)
(progn
(setq en (entmakex dxf))
(if (ydd en 10 p1)
(entdel en);(command "_.erase" en "")
)
)
)
)
)
(setvar "dimpost" ".");标注无前后缀
(setvar "cmdecho" 1)
(princ)
)

669423907 发表于 2018-7-27 11:57:53

namezg 发表于 2018-7-27 11:32
;重新对代码进行了大量改动，应该比原来的好。

(defun pdjd (/ o1 o2 lst jd fx);(pdjd);判断角度

最后改的有些问题：如果第二点没有落在图元上，标注的字体会变小了

namezg 发表于 2018-7-27 12:25:00

你把
(setq dxf (entget (setq en (entlast)))
改为
(setq dxf (entget (setq en (entlast)) '("*")))
试试

namezg 发表于 2018-7-27 12:41:09

如果不行，你发一个你的dwg文件上来。

669423907 发表于 2018-7-27 13:42:17

namezg 发表于 2018-7-27 12:25
你把
(setq dxf (entget (setq en (entlast)))
改为

可以咯，谢谢谢谢:handshake

namezg 发表于 2018-7-27 14:26:04

本帖最后由 namezg 于 2018-7-27 14:41 编辑

;再来一个版本，用命令oops

(defun pdjd (/ o1 o2 lst jd fx);(pdjd);判断角度
   (setq o1(cadr(grread 3))
               o2(cadr(grread 3))
   );光标位置
   (setq lst (view-ucs-box));屏幕左上、右下两对角点UCS
   (while (<(distance o1 o2)(*(distance(car lst)(cadr lst))0.008))
            (setq o2 (cadr (grread 3)));光标位置
            (setq lst (view-ucs-box))
   )
   (setq jd (/(*(angle o1 o2)180)pi));两点与X轴的角度
   (if (or (<= 45 jd 135) (<= 225 jd 315))
            (setq fx "V");垂直
            (setq fx "H");水平
   )
)

;动态线性标注，两点均在对象上时自动加前缀%%c、M
(defun c:66(/ p1 fx entxt p2)
   (setvar "cmdecho" 0)
   (if (setq p1 (getpoint "\n请指标注起点:"))
            (progn
                     (setvar "dimpost" ".");标注无前后缀
                     (command "dimlinear" "non" p1 "non" p1 (setq fx (pdjd)) "non" p1)
                     (ydd (entlast) 14 p1)
                     (command "_.erase" en "")
                     (setq p2 (cadr (grread 3)))
                     (if (and (nentselp p1)(nentselp p2))
                           (progn
                                    (command "oops")
                                    ;方法1(文字替代)
                                    ;(command "dimedit" "n" "%%c<>" en "");可代替上面一行
                                    ;方法2(加前缀)
                                    (setvar "dimpost" "%%c<>")
                                    (command "dimstyle" "apply" en "")
                                    (princ "\n当前前缀为%%c，右键可将前缀改为M。")
                                    (if (ydd en 10 p1)
                                             (progn
                                                   ;方法1(文字替代)
                                                   ;(command "dimedit" "n" "M<>" en "");可代替上面一行
                                                   ;方法2(加前缀)
                                                   (setvar "dimpost" "M<>")
                                                   (command "dimstyle" "apply" en "")
                                             )
                                    )
                           )
                           (progn
                                    (command "oops")
                                    (if (ydd en 10 p1)
                                             (command "_.erase" en "")
                                    )
                           )
                     )
            )
   )
   (setvar "dimpost" ".");标注无前后缀
   (setvar "cmdecho" 1)
   (princ)
)

bai2000 发表于 2018-7-27 17:25:26

能定字高更好

583775698 发表于 2018-8-5 22:19:04

怎么没有演示的GIF呢

页: 1 2 [3]

明经CAD社区's Archiver