划线标注，非常好用，求大神优化一下标注全局比例！

cq4920 · 发表于 2019-12-24 18:16:01

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

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

×

(defun C:dsa (/ minsize pt1 bzbl pt2 ss intlist
x y lds olden pts1 pts2 n ens
code i ptx endata
)
(command "DIMSCALE" BZBL)
(defun *error* (msg)
(setvar "osmode" osm);;还原捕捉点设置
(princ "\n程序终止")
(if (< (atof (getvar "acadver")) 20.0)
(command "undo" "end")
(command-s "undo" "end")
)
)
(princ "\nF3 临时切换捕捉开关,默认关闭");;设置F3键，可能是习惯吧
(princ "\n过滤尺寸下限:不生成小于此数值的尺寸标注的")
(setq osm (getvar "osmode"));;存储捕捉点设置
(if ddf_old_minsize
(setq minsize ddf_old_minsize)
)
(command "undo" "be")
(if
(progn (initget "S")
(setq pt1 (getpoint "\n指定标注起始方向/设置过滤尺寸(S)"))
)
(progn
(while (= "S" pt1)
(if (null ddf_old_minsize)
(setq minsize (getdist "\n请输入过滤尺寸,默认为<5mm>"))
(setq minsize (getdist (strcat "\n请输入过滤尺寸,上次输入为<"
(rtos ddf_old_minsize 2 2)
"mm>"
)
)
)
)
(if (null minsize)
(setq minsize 5)
)
(setq ddf_old_minsize minsize)
(initget "S")
(setq pt1 (getpoint "\n指定标注起始方向/设置过滤尺寸(S)"))
) ;end while
(if (null minsize)
(setq minsize 5)
)
(setq ddf_old_minsize minsize)
(setq pt2 (getpoint pt1 "\n指定标注方向"))
(if (and pt1 pt2)
(progn
(setq pt1(polar pt1 (angle pt2 pt1) minsize))
(setq pt2(polar pt2 (angle pt1 pt2) minsize))
)
)
(if (setq ss (ssget "F"
(list pt1 pt2)
;;'((0 . "*E,CIRCLE,ARC") (6 . "BYLAYER"))
)
)
(progn
(setq intlist ()
endata (ssnamex ss)
)
(foreach x endata
(foreach y (cdddr x) (setq intlist (cons (cadr y) intlist)))
)
;;点要排序一下才行,按从开始点的距离来排序
(setq lds (+ 10 (distance pt1 pt2)))
(setq intlist (vl-remove-if-not
'(lambda (x) (<= (distance x pt1) lds))
intlist
)
)
(setq
intlist (vl-sort intlist
'(lambda (x y)
(< (distance pt1 x) (distance pt1 y))
)
)
)
;;这里开始写标注程序
(setq olden (entlast)
ss (ssadd)
)
(setq n 0)
(repeat (- (length intlist) 1)
(setq pts1 (nth n intlist)
pts2 (nth (1+ n) intlist)
)
(if (> (distance pts1 pts2) minsize)
(ddf_entmakedim pts1 pts2)
)
(setq n (1+ n))
) ;end repeat
(while (setq ens (entnext olden))
(setq ss (ssadd ens ss)
olden ens
)
)
(if(>(getvar"OSMODE")16384)(princ)(setvar"OSMODE"(+(getvar"OSMODE")16384)));;默认关闭捕捉
;(if(>(getvar"OSMODE")16384)(setvar"OSMODE"(-(getvar"OSMODE")16384))(princ));默认打开捕捉
;;下面开始来移动
(setq loop t);;;带捕捉的grread框架开始
(while loop
(setq gr (grread t 15 0) code (car gr) ptx (cadr gr))
(cond
((= code 3)(redraw) (setq loop nil)) ; 鼠标左键
((= code 5) ; 鼠标移动
(redraw)
(if (>(getvar"OSMODE")16384)
(princ)
(setq ptx (osnappt nil ptx))
)
;;根据获取的动态点坐标更新程序-开始
(setq i 0)
(repeat (sslength ss)
(setq endata (entget (ssname ss i)))
(entmod (subst (cons 10 ptx) (assoc 10 endata) endata))
(setq i (1+ i))
); end repeat
;;根据获取的动态点坐标更新程序-结束
)
((member code '(2 6)) ; 键盘输入--"F3"键
(if(>(getvar"OSMODE")16384)(setvar"OSMODE"(-(getvar"OSMODE")16384))(setvar"OSMODE"(+(getvar"OSMODE")16384))));切换捕捉开关
;((= code 2) ; 键盘输入
; (princ "\n键盘输入=")(princ pt))
((member code '(11 25)); 鼠标右击
(redraw) (setq loop nil)
)
)
);end while;;;;;带捕捉的grread框架结束
)
) ;end if
);end progn
) ;end if
(princ "\n标注完成")
(setvar "osmode" osm);;还原捕捉点设置
(command "undo" "END")
(prin1)
) ;end
(defun ddf_entmakedim (pt1 pt2 /)
(cond
((or (equal 0 (angle pt1 pt2) 0.001)
(equal pi (angle pt1 pt2) 0.001)
)
(entmake
(list
'(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10 pt1)
'(70 . 32)
'(1 . "")
'(100 . "AcDbAlignedDimension")
(cons 13 pt1)
(cons 14 pt2)
'(100 . "AcDbRotatedDimension")
)
)
)
((or (equal (/ pi 2) (angle pt1 pt2) 0.001)
(equal (* pi 1.5) (angle pt1 pt2) 0.001)
)
(entmake
(list
'(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10 pt1)
'(70 . 33)
'(1 . "")
'(100 . "AcDbAlignedDimension")
(cons 13 pt1)
(cons 14 pt2)
)
)
)
((and (null (equal 0 (angle pt1 pt2) 0.001))
(null (equal (/ pi 2) (angle pt1 pt2) 0.001))
)
(entmake
(list
'(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10 pt1)
'(70 . 33)
'(1 . "")
'(100 . "AcDbAlignedDimension")
(cons 13 pt1)
(cons 14 pt2)
)
)
)
) ;end cond
) ;end
(prin1)
;;; grread捕捉子函数
;;; name为移动的图元名，pt为光标点
;;; 返回值：如果有捕捉点则返回捕捉点，无则返回光标点
;;
(defun osnappt (name pt / color d h k lst nearpt nearpt2 osmo pt1 pt2 pt3 pt4 pt5 ptx pty x)
(if name (entdel name))
(redraw)
(if (< (getvar "osmode") 16384);;打开捕捉
(progn
(setq color (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))))
h (/ (getvar "viewsize") (cadr (getvar "screensize"))) d (getvar "pickbox")
lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h)) k (* 1.5 d h))
(if (setq nearpt (osnap pt "_END,_CEN,_NOD,_QUA,_INS,_TAN,_EXT"))(setq osmo 1))
(if (and(setq nearpt2 (osnap pt "_NEA"))(not (equal nearpt nearpt2 k)))
(setq osmo 2 nearpt nearpt2))
(if (and(setq nearpt2 (osnap pt "_MID"))(equal nearpt nearpt2 k))
(setq osmo 3 nearpt nearpt2))
(if (and(setq nearpt2 (osnap pt "_INT"))(equal nearpt nearpt2 k))
(setq osmo 4 nearpt nearpt2))))
(if name(entdel name))
(if nearpt
(progn
(setq ptx (car nearpt)pty (cadr nearpt))
(foreach x lst
(setq pt1 (list (- ptx x) (- pty x)) pt2 (list (+ ptx x) (- pty x))
pt3 (list (+ ptx x) (+ pty x)) pt4 (list (- ptx x) (+ pty x))
pt5 (list ptx (+ pty x)))
(cond
((= osmo 1)(grvecs (list color pt1 pt2 pt2 pt3 pt3 pt4 pt4 pt1)))
((= osmo 2)(grvecs (list color pt1 pt2 pt2 pt4 pt3 pt4 pt3 pt1)))
((= osmo 3) (grvecs (list color pt1 pt2 pt2 pt5 pt5 pt1)))
((= osmo 4) (grvecs (list color pt1 pt3 color pt2 pt4)))))
(setq pt nearpt)))
pt
)

这是一个非常好的划线标注命令！求大神增加一下标注尺寸的全局比例！每次标注的尺寸太小了！如果可以根据视口大小或者手动设置就完美了！

Michael527 · 发表于 2019-12-25 22:13:56

你的BZBL变量好像没赋值？

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

[求助] 划线标注，非常好用，求大神优化一下标注全局比例！

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