26
177
7
后起之秀
本帖以下内容被隐藏保护;需要你回复后,才能看到!
使用道具 举报
3072
10
社区元老
;修改<35%代码,请标明aeo ;有更好的,希望贴出来大家分享 (defun c:TD (/ ang e en j len olderr os pt1 pt2 pt3 pt4 ss aeoerr trim-dim dxf ) (defun dxf (a b) (cdr (assoc a b))) (defun aeoerr (msg) (command "_.undo" "end" ^c) (setvar "osmode" os) (setq *error* olderr) ) (defun trim-dim (pt1 pt2 ss / ent entl i np13 np14 p10 p13 p14 ptt) ; 这一; 段改自"程序(函数)库" (setvar "osmode" 0) (setq pt1 (trans pt1 1 0) pt2 (trans pt2 1 0) i 0 ) (repeat (sslength ss) (setq ent (ssname ss i) entl (entget ent) p10 (cdr (assoc 10 entl)) p13 (cdr (assoc 13 entl)) p14 (cdr (assoc 14 entl)) ptt (cdr (assoc 11 entl)) i (1+ i) np14 (inters pt1 pt2 p14 p10 nil) ) (if (not (member '(100 . "AcDbRotatedDimension") entl)) (setq np13 (polar np14 (angle p14 p13) (distance p14 p13))) (setq np13 (inters pt1 pt2 p13 (polar p13 (angle p14 p10) 100) nil ) ) ) (setq entl (subst (cons 13 np13) (assoc 13 entl) entl ) entl (subst (cons 14 np14) (assoc 14 entl) entl ) ) (entmod entl) ) ) ;;;;;;; (setq os (getvar "osmode") olderr *error* *error* aeoerr ) (setvar "osmode" 0) (command "undo" "group") (prompt "\nby aeo") (prompt "\n不要修改的标注不要选在里面") (if (setq ss (ssget '((0 . "DIMENSION")))) (progn (setq en (entget (ssname ss 0))) (if (member '(100 . "AcDbRotatedDimension") en) (setq ang (dxf 50 en)) (setq ang (angle (dxf 13 en) (dxf 14 en))) ) ) ) (setvar "osmode" 15359) (if (and ang (setq pt1 (getpoint "\n标注线位置(回车不改):")) ) (progn (setq pt2 (polar pt1 ang 1000) j 0 len (sslength ss) ) (setvar "osmode" 0) (while (< j len) (setq e (ssname ss j) en (entget (ssname ss j)) pt3 (dxf 10 en) pt4 (inters pt1 pt2 pt3 (polar pt3 (+ ang (* 0.5 pi)) 100) nil ) j (1+ j) ) (command "move" e "" pt3 pt4) ) ) ) (setvar "osmode" 15359) (if (and ang (setq pt1 (getpoint "\n引出线位置(回车不改):")) ) (trim-dim pt1 (polar pt1 ang 100) ss) ) (setvar "osmode" os) (setq *error* olderr) (command "_.undo" "end") (princ) )
0
1
初来乍到
39
97
6
本版积分规则 发表回复 回帖后跳转到最后一页
微信公众平台
扫描访问手机版
点击图片下载手机App
|关于我们|小黑屋|乐筑天下 繁体中文
GMT+8, 2025-7-8 05:00 , Processed in 0.931694 second(s), 67 queries .
© 2020-2025 乐筑天下
在线时间:10:00-17:00
暂无
扫一扫,关注我们
帮助中心
关于我们
下载APP客户端