拉线标注如何过滤多段线线宽？谢谢~
(defun C:LXBZ (/ minsize pt1 pt2 ss intlistx 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
)
http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTQyMTgzfDZjOTJmMWUyfDE3NDc4MTk5MzZ8NzMzMzI0M3wxOTEyNTg%3D&noupdate=yes
拉线标注原帖
这是找到的最好的一段拉线标注代码了，但有个小问题：如果矩形的线条有宽度，就会出现这样的情况，请问怎么修正啊？搜索了很久，也用DeepSeek寻求帮助都没有解决。矩形上方标注为现有插件生成，下方为想要标注尺寸，谢谢~
;; 交点连标
为啥用不了啊，原贴在哪里啊
这个问题不是很简单吗? (b.X-a.X)/2 332398174 发表于 2025-5-21 18:12
为啥用不了啊，原贴在哪里啊
能用，但功能还不完全是我想要的，点“拉线标注原帖”可跳转～ 你有种再说一遍 发表于 2025-5-21 18:21
这个问题不是很简单吗? (b.X-a.X)/2
求大佬详细指导啊～ xyp1964 发表于 2025-5-21 20:48
;; 交点连标
求版主指导修改啊…那个QDIM只可以选择横向的，并且不能像你的一样标注首位总的～ 逗亦斗霸 发表于 2025-5-21 22:59
求版主指导修改啊…那个QDIM只可以选择横向的，并且不能像你的一样标注首位总的～
为啥我的用不了啊，一选就OVER
逗亦斗霸 发表于 2025-5-21 22:59
求版主指导修改啊…那个QDIM只可以选择横向的，并且不能像你的一样标注首位总的～
像我们这种不懂的，要想快，花钱，一下就搞好了，
页:
[1]