求修改拉线标注
在明经看到的一个拉线标注代码，但是不管遇到文字还是填充或者尺寸，它都会识别出来。请求大神增加过滤文字、填充、标注功能。
代码如下：
(defun C:LXBZ (/ minsize pt1 pt2 ss intlist
x y lds olden pts1 pts2 n ens
code i ptx endata
)
(prompt "【快速拉线标注，产生交点的位置都会被认为是标注点】")
(setvar "CMDECHO" 0)
(YY_KAISHI_YY)
(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标注完成")
(YY_END_YY)
(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捕捉子函数
(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
)
(defun C:LXBZ (/ minsize pt1 pt2 ss intlist
x y lds olden pts1 pts2 n ens
code i ptx endata
)
(prompt "【快速拉线标注，产生交点的位置都会被认为是标注点】")
(setvar "CMDECHO" 0)
(YY_KAISHI_YY)
(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)
'((-4 . "<not")(0 . "*TEXT,DIMENSION,HATCH")(-4 . "not>"))
)
)
(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标注完成")
(YY_END_YY)
(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捕捉子函数
(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
)
qazxswk 发表于 2024-9-27 05:55
非常感谢，试验了下，文字填充尺寸都能够过滤，但是如果是块里的文字填充尺寸，还是不能过滤。 本帖最后由 qazxswk 于 2024-9-27 14:32 编辑
那就把块也过滤了。 增加了过滤块的功能。
(defun C:LXBZ (/ minsize pt1 pt2 ss intlist
x y lds olden pts1 pts2 n ens
code i ptx endata
)
(prompt "【快速拉线标注，产生交点的位置都会被认为是标注点】")
(setvar "CMDECHO" 0)
(YY_KAISHI_YY)
(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)
'((-4 . "<not")(0 . "*TEXT,DIMENSION,HATCH,INSERT")(-4 . "not>"))
)
)
(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标注完成")
(YY_END_YY)
(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捕捉子函数
(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
)
谢谢，块我还是不过滤了，有时候需要天花灯具定位 那就是无解了 qazxswk 发表于 2024-9-27 01:26
老大，想咨询个下，这个拉线标注，有时候有一个标注的字样式会在反的方向，正常是在左，有时候有1个会在右边，有试了好多，应该不是标注生产和移动那边的，我估计是点那边，碰到重叠的线的时候会这样。这个有没有办法拯救 :hug:好代码，学习了:lol
页:
[1]