CAD动态对齐箭头引线+文字—带捕捉插件源码文件

云墨 2021年12月2日11:10:32工具插件评论4047322字阅读24分24秒阅读模式

动态对齐箭头 引线+文字,带动态捕捉点,捕捉开关和系统设置osnap开关挂钩,

CAD动态对齐箭头引线+文字—带捕捉插件源码文件

CAD动态对齐箭头引线+文字—带捕捉插件源码文件

(defun c:aa()(C:dynamic-align-LEADER))
(defun c:aa1()(setq *textpoint-ctrl T) (C:dynamic-align-LEADER));文字在引线上面
(defun c:aa2()(setq *textpoint-ctrl nil) (C:dynamic-align-LEADER))
;;组操作
(defun C:AASZ()
        (if *textpoint-ctrl
                (progn
                        (setq *textpoint-ctrl nil)
                        (princ "\n文字在引线后面<<<<<<<<<<<<<<<<<<<<<<<<<")
                )
                (progn
                        (setq *textpoint-ctrl T)
                        (princ "\n文字在引线上面>>>>>>>>>>>>>>>>>>>>>>>>>")
                )
        )
        (princ)
)
(defun C:dynamic-align-LEADER(/ ss code ent gr loop name pt ang0 dist0 ss-enlst ss-leader ss-text DDian elist-res text-info pt_temp pt1 Text_alignment_pt xyp-DXF xyp-Etype leader-last-pt pdyxfx)
        (defun ss-enlst        (ss / enlst)
                (cond
                        ((= (type ss) 'PICKSET)
                                (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
                        )
                        ((= (type ss) 'LIST)
                                (setq enlst (ssadd))
                                (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
                        )
                )
        )
        ;检查文字的对齐点是第一对齐点10,还是第二对齐点11
        (defun Text_alignment_pt(ename)
                (if
                        (or (equal (xyp-DXF '(72 73) ename) '((72 0)(73 0)))
                                (equal (xyp-DXF 0 ename) "MTEXT")
                        )
                        (assoc 10 (entget ename))
                        (assoc 11 (entget ename))
                )
        )
        ;; xyp-DXF 实体dxf数据 (xyp-DXF code ename)
        (defun xyp-DXF (code ename / ent lst a)
                (if (= (type code) 'LIST)
                        (progn
                                (setq ent   (entget ename)
                                        lst  '()
                                )
                                (foreach a code
                                        (setq lst (cons (list a (cdr (assoc a ent))) lst))
                                )
                                (reverse lst)
                        )
                        (if (= code -3)
                                (cdr (assoc code (entget ename '("*"))))
                                (cdr (assoc code (entget ename)))
                        )
                )
        )
        ;; xyp-Etype 检查实体类型 (xyp-Etype ename etype)
        (defun xyp-Etype (ename etype)
                (wcmatch (xyp-dxf 0 ename) (strcase etype))
        )
        (defun mydxf (ent n);;;查询DXF内容
                (if (= (type ent) 'ename)
                        (setq ent (entget ent))
                )
                (cdr (assoc n ent))
        )
        (defun pdyxfx (ent / jds bili jd jd0x jd0y jd1x jd1y jd2x jd2y yxfx);;;判断引线方向
                (setq jds (mydxf ent 76))
                (setq bili (vla-get-ScaleFactor (vlax-ename->vla-object ent)))
                (setq jd (vla-get-Coordinates (vlax-ename->vla-object ent)))
                (setq jd (vlax-safearray->list (vlax-variant-value jd)))
                (setq
                        ;jd0x (nth (- (* jds 3) 9) jd);;取倒数第三个点的x坐标
                        ;jd0y (nth (- (* jds 3) 8) jd);;取倒数第三个点的y坐标
                        jd1x (nth (- (* jds 3) 6) jd);;取倒数第二个点的x坐标
                        jd1y (nth (- (* jds 3) 5) jd);;取倒数第二个点的y坐标
                        jd2x (nth (- (* jds 3) 3) jd);;取倒数第一个点的x坐标
                        jd2y (nth (- (* jds 3) 2) jd);;取倒数第一个点的y坐标
                )
                (if (> (abs (- jd1x jd2x)) (abs (- jd1y jd2y)));true为横向
                        (if (> jd1x jd2x)
                                (setq yxfx "HR")
                                (setq yxfx "HL")
                        )
                        (if (> jd1y jd2y)
                                (setq yxfx "VU")
                                (setq yxfx "VD")
                        )
                )
                yxfx
        )
        ;;;获取引线最后一个顶点
        (defun leader-last-pt (ent / jds jd jd1x jd1y jd2x jd2y)
                (setq jds (xyp-DXF 76 ent))
                (setq jd (vla-get-Coordinates (vlax-ename->vla-object ent)))
                (setq jd (vlax-safearray->list (vlax-variant-value jd)))
                (setq jd1x (nth (- (* jds 3) 6) jd);;取倒数第二个点的x坐标
                        jd1y (nth (- (* jds 3) 5) jd);;取倒数第二个点的y坐标
                        jd2x (nth (- (* jds 3) 3) jd);;取倒数第一个点的x坐标
                        jd2y (nth (- (* jds 3) 2) jd);;取倒数第一个点的y坐标
                )
                (list jd2x jd2y);引线的倒数第1个点
        )
        (if *textpoint-ctrl
                (princ "\n文字在引线上面>>>>>>>>>>>>>>>>>>>>>>>>>执行C:AASZ切换")
                (princ "\n文字在引线后面<<<<<<<<<<<<<<<<<<<<<<<<<执行C:AASZ切换")
        )
        (prompt "\n请选择引线和文字:")
  (if (setq ss (ssget '((0 . "LEADER,*TEXT"))))
                (progn
                        (command "_undo" "_be")
      (setq loop t)
                        (setq ss (ss-enlst ss))
                        (if        (and
                                                (setq ss-leader (vl-remove-if-not        '(lambda (x) (xyp-Etype x "LEADER"))        ss));筛选引线
                                                (setq ss-text (vl-remove-if-not        '(lambda (x) (xyp-Etype x "*TEXT")) ss));筛选文字
                                        )
                                (progn
                                        (setq pt0 (leader-last-pt(car ss-leader)));;获取参照点
                                        (setq text-info(mapcar '(lambda (x / pt-tt)
                                                                                                                                                (progn
                                                                                                                                                        (setq pt-tt (Text_alignment_pt x))
                                                                                                                                                        (cons x (list(list (distance pt0 (cdr pt-tt)) (angle pt0 (cdr pt-tt)))))
                                                                                                                                                )
                                                                                                                                        )
                                                                                                         ss-text
                                                                                                 );;((文字图元名 (文字对齐点 角度 距离))(文字图元名 (文字对齐点 角度 距离)))
                                        );;建立文本相对位置关系表
                                )
                        )
                        (princ "\n指定点:")
                        (princ "\n指定点[开/关捕捉(F3)]:")
                        (while loop
                                (if (null ss-leader) (exit))
        (setq gr (grread t 15 0) code (car gr) pt (cadr gr))
        (cond
          ((= code 3)(redraw) (setq loop nil))  ; 鼠标左键
          ((= code 5)                  ; 鼠标移动
                                                (redraw)
                                                (if (>(getvar"OSMODE")16384)
                                                        (princ)
                                                        (setq pt (osnappt name pt))
                                                )
                                                (setq pt(trans pt 1 0))
                                                (if ss-leader;;移动引线
                                                        (foreach name ss-leader
                                                                (setq ent (entget name))
                                                                (setq DDian (vl-remove-if-not
                                                                                                                        '(lambda (x) (member (car x) '(10)))
                                                                                                                        ent
                                                                                                                )
                                                                );;获取引线的顶点表((10 x y z)(10 x y z)...)
                                                                (setq DDian (reverse(cdr(reverse DDian))));;剔除引线最后一个顶点
                                                                ;(setq DDian (vl-remove (last DDian) DDian));;剔除引线最后一个顶点
                                                                (setq elist-res (vl-remove-if
                                                                                                                                        '(lambda (x) (member (car x) '(10)))
                                                                                                                                        ent
                                                                                                                                )
                                                                )
                                                                (setq pt1(leader-last-pt name))
                                                                (setq pt_temp (subst  (nth 0 pt) (nth 0 pt1) pt1));更新X坐标
                                                                (setq ent (append elist-res DDian (list(cons 10 pt_temp))));重新组合
                                                                (entmod ent)
                                                        )
                                                )
                                                (if (and ss-leader ss-text);;移动文字
                                                        (foreach name ss-text
                                                                (setq ent (entget name))
                                                                (setq pt0 (leader-last-pt(car ss-leader)));;获取参照点
                                                                (setq dist0 (car(cadr(assoc name text-info))))
                                                                (setq ang0 (cadr(cadr(assoc name text-info))))
                                                                (setq pt_align_new(polar pt0 ang0 dist0))
                                                                (setq pt_align_code(car(Text_alignment_pt name)))
                                                                (entmod (setq ent (subst(cons pt_align_code pt_align_new)(assoc pt_align_code ent)ent)))
                                                        )
                                                )
                                        )
                                        ((member code '(2 6))                  ; 键盘输入
                                                (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)
                                        )
                                )
                        )
                        ;Worlducs        指示 UCS 是否与 WCS 相同。0. UCS 与 WCS 不同 1. UCS 与 WCS 相同
                        (if (and ss-text (=(getvar "Worlducs")1))
                                (progn
                                        (setq yxfx (pdyxfx(car ss-leader)))
                                        (cond
                                                ((and(= yxfx "HL")*textpoint-ctrl)(setq amode "R"));尾端
                                                ((and(= yxfx "HR")*textpoint-ctrl)(setq amode "L"));尾端
                                                ((and(= yxfx "HL")(NULL *textpoint-ctrl))(setq amode "L"))
                                                ((and(= yxfx "HR")(NULL *textpoint-ctrl))(setq amode "R"))
                                        )
                                        (process-align-text (ss-enlst ss-text) (leader-last-pt(car ss-leader)))
                                )
                                (princ "\当前绘图坐标系,非WCS坐标系,不支持文字对齐,因为容易出错!!!")
                        );;添加额外的操作
                        (command "_undo" "_E")
                )
        )
        (princ)
)
(defun process-align-text (selobjs         apnt /                apnt        apnt_x
                                                                                                                apnt_y          count            objname   vlaxobj        MinPoint
                                                                                                                MaxPoint  minext   maxext   ext_l        ext_r
                                                                                                                ext_m          tpnt temp
                                                                                                        )
        (if (null amode)
    (setq amode "L")
  )
  (initget "L R")
  (if(setq        temp (getkword
                                                                         (strcat
                                                                                 "\n选择对齐方式[左对齐(L)/右对齐(R)]<("amode")>:"
                                                                         )
                                                                 )
                 )
                (setq amode temp)
        )
        (cond
                ((= amode "L")                        
                        (command "justifytext" selobjs "" amode)                        
                )
                ((= amode "R")                        
                        (command "justifytext" selobjs "" amode)                        
                )
        )
        (initget 1)
        (setq apnt(trans apnt 1 0))
  (setq        apnt_x (car apnt)
                apnt_y (cadr apnt)
  )
  (vl-load-com)
  (setq count 0)
  (repeat (sslength selobjs)
    (setq objname (ssname selobjs count))
    (setq vlaxobj (vlax-ename->vla-object objname))
    (setq MinPoint (vlax-make-variant))
    (setq MaxPoint (vlax-make-variant))
    (vla-GetBoundingBox vlaxobj 'MinPoint 'MaxPoint)
    (setq minext (vlax-safearray->list MinPoint))
    (setq maxext (vlax-safearray->list MaxPoint))
                (setq minext(trans minext 1 0));;;
                (setq maxext(trans maxext 1 0));;;
    (setq ext_l (car minext))
    (setq ext_r (car maxext))
    (setq ext_m (+ (/ (abs (- ext_l ext_r)) 2) ext_l))
    (cond
      ((= amode "L")
                                (setq tpnt (list ext_l apnt_y))
      )
      ((= amode "M")
                                (setq tpnt (list ext_m apnt_y))
      )
      ((= amode "R")
                                (setq tpnt (list ext_r apnt_y))
      )
    )
    (if        tpnt
                        (progn
                                (command "_move" objname "" "_none" (trans tpnt 1 0) "_none" (trans apnt 1 0))
                                (if amode        (command "justifytext" objname "" (strcat (if *textpoint-ctrl "" "M")  amode)))
                        )
    )
    (setq count (1+ count))
  )
)
;;; 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
)
(princ "\n动态对齐文字引线命令 C:AA----默认:上面")
(princ "\n动态对齐文字引线命令 C:AA1---文字在引线上面")
(princ "\n动态对齐文字引线命令 C:AA2---文字在引线后面")
(princ "\n动态对齐文字引线命令 C:AASZ--切换AA对应的模式")
(princ)

1. 如有链接无法下载、失效或广告,请联系QQ:3392178029 处理!
2. 本站的所有资源为购买、网络收集,或者用户投稿的资源,版权归原作者及网站所有!
3. 如若侵犯了您的权利,请及时联系站长删除!
4. 本站提供的资源,都不包含技术服务请大家谅解!
5. 此软件“仅限学习交流,不能用于商业用途”!
6. 如用于商业用途,请到官方购买正版软件,追究法律责任与“猿沐软件网”无关!
  • 老师个人微信
  • 微信扫一扫
  • weinxin
  • 设计课堂公众号
  • 微信扫一扫
  • weinxin
云墨
  • 本文由 发表于 2021年12月2日11:10:32
  • 转载请务必保留本文链接:https://www.yuanmoo.net/6139.html【猿沐软件网】
匿名

发表评论

匿名网友 填写信息

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: