增加了过滤块的功能。
 - (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
- )
| 
发表于 2024-9-27 01:26:30
置顶卡
变色卡
显身卡
楼主