明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4366|回复: 18

[已解答] 高手帮写个文字对齐线

[复制链接]
发表于 2014-12-22 22:05 | 显示全部楼层 |阅读模式
10明经币
本帖最后由 iszc 于 2014-12-22 22:19 编辑

论坛找很多,没有适合要求的。
能帮忙写一个单行文字对齐pline及line线,先选单行文字(如果能支持多行文字更好)再选需对齐的线,文字位置屏幕指定,文字旋转方向与线段同向。且点线段的左侧,文字方向即从线段左侧开始对齐,点线段右侧,文字方向从线段右侧开始对齐

最佳答案

查看完整内容

现写的,将就练手

点评

贴图说明  发表于 2014-12-25 20:53
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2014-12-22 22:05 | 显示全部楼层
本帖最后由 wzg356 于 2014-12-24 12:48 编辑

现写的,将就练手
  1. ;wzg 356 于20141222
  2. ;;;文字达到齐线效果,文字与直线角度一致后,想放哪儿就放哪儿。
  3. (defun c:tt3 ( / PickSegEndPt en1 en2 enl1 enl2 p1 p2 p1p2 gr gr-model gr-value tmp)
  4. ;;多段线所点击子段的两端点列表,from 明经
  5. (defun PickSegEndPt (obj p / pp n)
  6.   (setq  pp (vlax-curve-getclosestpointto obj (trans p 1 0))
  7.         n  (fix (vlax-curve-getparamatpoint obj pp)))
  8.   (list  (vlax-curve-getPointAtParam obj n)
  9.         (vlax-curve-getPointAtParam obj (1+ n)))
  10. )
  11. (while
  12.   (not(and
  13.         (setq en1 (entsel "\n选择单行文字:"))
  14.         (= (cdr (assoc 0 (setq enl1(entget(car en1))))) "TEXT")
  15.         )
  16.     )        
  17. )
  18. (while
  19.   (not(wcmatch
  20.     (cdr(assoc 0(setq enl2(entget(car (setq en2 (entsel "\n选择直线...")))))))
  21.     "*LINE"
  22.     )
  23.   )
  24. )
  25. (if  (= (cdr (assoc 0 enl2)) "LINE")
  26.         (setq p1 (cdr (assoc 10 enl2))
  27.                 p2 (cdr (assoc 11 enl2))
  28.         )
  29.         (progn
  30.             (setq p1p2(PickSegEndPt (car en2) (cadr en2)))
  31.             (setq p1 (car p1p2)
  32.                   p2 (cadr p1p2)
  33.             )
  34.         )
  35. )
  36. (if(or(> (car p1) (car p2))
  37.     (and
  38.         (equal (car p1) (car p2) 0.00001)
  39.         (> (cadr p1) (cadr p2))
  40.     ))
  41.    (setq tmp p2
  42.          p2  p1
  43.         p1 tmp
  44.     )
  45. )
  46. (setq enl1 (subst (cons 50 (angle p1 p2)) (assoc 50 enl1) enl1)
  47.       enl1 (subst (cons 72 0) (assoc 72 enl1) enl1)
  48.     enl1 (subst (cons 73 0) (assoc 73 enl1) enl1)
  49. )
  50. (princ "\n请摆放在恰当位置:")
  51. (setq gr 0 gr-model 0 gr-value 0 )
  52. (while (/= gr-model 3)
  53.         (setq gr (grread T 8)   
  54.                   gr-model (car gr)   
  55.                   gr-value (cadr gr)
  56.         )                        
  57.         (if        (and gr (=  gr-model 5))
  58.                 (entmod (subst (cons 10 gr-value) (assoc 10 enl1) enl1))
  59.         )
  60. )
  61. (PRINC)
  62. )

复制代码
回复

使用道具 举报

发表于 2014-12-23 08:48 | 显示全部楼层
;;;  ===============================
;;;  文字齐线
;;;  命令:wzqx
;;;  by PEACE 2013/07/14 V1.0
;;;           2013/07/19 V1.1 支持MTEXT
;;;           2013/07/19 V1.2
;;;           2013/07/19 V1.3 修改偏移的bug
;;;  ===============================

(vl-load-com)
(defun c:wzqx( /
               ;局部函数
               *error*
               PEACE:StoreSysVarCAD
               PEACE:RestoreSysVarCAD
               PEACE:SaveSysVarPeace
               PEACE:ReadSysVarPeace
               PEACE:Fsxm-ssget
               SaveSysVar
               GETDATA
               ;局部变量
               vcmde vblip vclay vosmo vplwd vlupr vdelo vtsty ;系统变量
               textss textent texth p1 p2 gr code data i ang d dq1 dq2 dq3
               pnum tnum1 tnum2 dclname tempname filen stream dcl_re textt
               textname textd
               ;全局变量
                              )
;局部函数开始
;自定义错误处理函数
(defun *error* (msg)
  (PEACE:RestoreSysVarCAD) ;还原系统变量
  (command ".UNDO" "E")
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
)
;储存系统变量
(defun PEACE:StoreSysVarCAD()
  (setq vcmde (getvar "cmdecho"))  ;普通命令的提示
  (setq vblip (getvar "blipmode")) ;光标痕迹
  (setq vclay (getvar "CLAYER"))   ;图层
  (setq vosmo (getvar "osmode"))   ;捕捉模式
  (setq vplwd (getvar "plinewid")) ;pl宽度
  (setq vlupr (getvar "luprec"))   ;长度精度
  (setq vdelo (getvar "delobj"))   ;控制创建面域时是否保留原pline,0为保留,1为不保留
  (setq vtsty (getvar "textstyle"))
)
;还原系统变量
(defun PEACE:RestoreSysVarCAD()
  (setvar "cmdecho" vcmde)
  (setvar "blipmode" vblip)
  (setvar "CLAYER" vclay)
  (setvar "osmode" vosmo)
  (setvar "plinewid" vplwd)
  (setvar "luprec" vlupr)
  (setvar "delobj" vdelo)
  (setvar "textstyle" vtsty)
)
;保存peace系统变量
(defun PEACE:SaveSysVarPeace(valname valvalue infotext / acadpath f datalist data valvalue_old i isthere)
  (setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
  (if (= infotext "")(setq infotext "no infotext"))
  (if (null (findfile "PEACESYSVAL.TXT"))
    (progn ;若文件不存在
      (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
      (prin1 (list valname valvalue infotext) f)
      (close f)
    )
    (progn ;若文件已存在
      (setq datalist '())
      (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
        (while (setq data (read-line f))
              (setq datalist (cons data datalist))
        )
      (close f)
      (setq datalist (reverse datalist))
      (setq       i 0
            isthere 0)
      (repeat (length datalist)
        (if (= valname (car (read (nth i datalist))))
          (progn
          (setq datalist (subst (vl-prin1-to-string (list valname valvalue infotext)) (nth i datalist) datalist))
          (setq isthere 1)
          )
        )
        (setq i (1+ i))
      )
      (if (= 1 isthere)
        (progn
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
          (prin1 (read (nth 0 datalist)) f)
          (close f)
          (setq i 1)
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
          (repeat (- (length datalist) 1)
            (write-line "" f)
            (prin1 (read (nth i datalist)) f)
            (setq i (1+ i))
          )
          (close f)
        )
        (progn
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
          (write-line "" f)
          (prin1 (list valname valvalue infotext) f)
          (close f)
        )
      )
    )
  )
  (princ)
)
;读取peace系统变量
(defun PEACE:ReadSysVarPeace( / acadpath data datalist i f)
  (setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
  (if (findfile "PEACESYSVAL.TXT")
    (progn
    (setq datalist '())
    (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
      (while (setq data (read-line f))
            (setq datalist (cons data datalist))
      )
      (reverse datalist)
    (close f)
    (setq i 0)
    (repeat (length datalist)
      (set (read (car (read (nth i datalist)))) ;注意字符和表之间的转换,字符串是不能作为变量名的
           (cadr (read (nth i datalist)))       ;car对字符串也是不起作用的
      )
      (setq i (1+ i))
    )
    )
  nil
  )
)
;;带关键字的ssget
;;Msg=提示信息,Kwd=关键字,Fil=条件
;示例:(PEACE:Fsxm-ssget "\n请选择一个圆:" "F" '((0 . "circle")))
(defun PEACE:Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var *acad* *doc*)
  (setq *acad* (vlax-get-acad-object))
  (setq *doc* (vla-get-ActiveDocument *acad*))
  ;===内部函数开始===
  ;;带过滤器的entsel
  (defun Fsxm-entsel (msg filter)
    (setq enp (entsel msg))
    (if (or (= (type enp) 'str)
           (and enp (ssget (cadr enp) filter))
        )
     enp
    )
  )
  ;;;用分隔符解释字符串成表
  (defun Fsxm-Split (string strkey / po strlst xlen)
    (setq xlen (1+ (strlen strkey)))
    (while (setq po (vl-string-search strkey string))
      (setq strlst (cons (substr string 1 po) strlst))
      (setq string (substr string (+ po xlen)))
    )
    (reverse (cons string strlst))
  )
  ;;点化字串
  (defun Fsxm-Pt2Str (pt)
    (strcat (rtos (car pt) 2 2)
            ","
            (rtos (cadr pt) 2 2)
            ","
            (rtos (caddr pt) 2 2)
            "\n"
    )
  )
  ;===内部函数结束===
  (cond
        ((cadr (ssgetfirst)))
        (T
         (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
         (initget (strcat Kwd0 " " kwd))
         (cond ((and (listp (setq var (Fsxm-entsel Msg Fil)))
                     (/= 52 (getvar "errno"))
                )
                (vla-sendcommand *doc* (Fsxm-Pt2Str (cadr (grread t))))
                (ssget Fil)
               )
               ((member var (Fsxm-Split Kwd0 " "))
                (vla-sendcommand *doc* (strcat var "\n"))
                (ssget Fil)
               )
               (t var)
         )
        )
  )
)
(defun SaveSysVar()
  (PEACE:SaveSysVarPeace "PEACE:TAL_O" PEACE:TAL_O "TAL文字偏移")
  (PEACE:SaveSysVarPeace "PEACE:TAL_D" PEACE:TAL_D "TAL文字行间距")
  (PEACE:SaveSysVarPeace "PEACE:TAL_AS" PEACE:TAL_AS "TAL文字对齐方式")
  (PEACE:SaveSysVarPeace "PEACE:TAL_P" PEACE:TAL_P "TAL文字位置")
)
(defun GETDATA()
  (setq   PEACE:TAL_O (atof (get_tile "ea01"))
          PEACE:TAL_D (atof (get_tile "ea02"))
  )
)
;局部函数结束
;主函数开始
  (PEACE:StoreSysVarCAD)  ;储存系统变量
  (PEACE:ReadSysVarPeace) ;读取peace系统变量
  (setvar "cmdecho" 0)
  (command ".UNDO" "BE")
  (princ "PEACE-TextAlignToLine 文字齐线")
  (if (not PEACE:TAL_O)(setq PEACE:TAL_O 1.5));文字偏移
  (if (not PEACE:TAL_D)(setq PEACE:TAL_D 1.5));文字行间距
  (if (not PEACE:TAL_AS)(setq PEACE:TAL_AS 1));文字对齐方式
  (if (not PEACE:TAL_P)(setq PEACE:TAL_P 1));文字位置
  (setq textss (PEACE:Fsxm-ssget "\n>>> 请选择文字或[设置(S)]:" "S" '((0 . "*TEXT"))))
  (if (or (= textss "S") (= textss "s"))
    (progn
    (setq dclname
      (cond
                ((setq tempname (vl-filename-mktemp "PEACEDCL.dcl")
                              filen (open tempname "w")
                 )
                 (foreach stream
                   '("\n" "TAL:dialog {\n"
                         "    label = \"文字齐线\" ;\n"
                         "    :row { :edit_box { label = \"偏移值\" ; key = \"ea01\" ; width = 10 ;   height = 1.2 ;  }  }\n"
                         "    :row { :edit_box { label = \"行间距\" ; key = \"ea02\" ; width = 10 ;   height = 1.2 ;  }  }\n"
                         "    :boxed_radio_row { label = \"文字位置\" ; \n"  
                         "      key=\"position\" ; \n"
                         "      :radio_button { label = \"线上\" ; key = \"ea03\" ; mnemonic = \"1\" ; value = 1 ; }\n"
                         "      :radio_button { label = \"线下\" ; key = \"ea04\" ; mnemonic = \"2\" ; }\n"
                         "               }\n"
                         "    :boxed_radio_row { label = \"对齐方式\" ; \n"  
                         "      key=\"alignstyle\" ; \n"
                         "      :radio_button { label = \"左\" ; key = \"ea05\" ; mnemonic = \"1\" ; value = 1 ; }\n"
                         "      :radio_button { label = \"中\" ; key = \"ea06\" ; mnemonic = \"2\" ; }\n"
                         "      :radio_button { label = \"右\" ; key = \"ea07\" ; mnemonic = \"3\" ; }\n"
                         "               }\n"
                         "    :row { :button { key = \"ea08\" ; label = \"确认\" ; is_default = true ;   }\n"
                         "           :button { key = \"ea09\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
                        )
                        (princ stream filen)
                 )
                 (close filen)
                 tempname
                )
      )
    )
    (setq dcl_re (load_dialog dclname))
    (if (not (new_dialog "TAL" dcl_re))
      (exit)
    )
    (mode_tile "ea08" 2)
    (set_tile "ea01" (rtos PEACE:TAL_O 2 2))
    (set_tile "ea02" (rtos PEACE:TAL_D 2 2))
    (cond
      ((= PEACE:TAL_P 1) (set_tile "ea03" "1"))
      ((= PEACE:TAL_P 2) (set_tile "ea04" "1"))
    )
    (cond
      ((= PEACE:TAL_AS 1) (set_tile "ea05" "1"))
      ((= PEACE:TAL_AS 2) (set_tile "ea06" "1"))
      ((= PEACE:TAL_AS 3) (set_tile "ea07" "1"))
    )
    (action_tile "ea03" "(setq PEACE:TAL_P 1)")
    (action_tile "ea04" "(setq PEACE:TAL_P 2)")
    (action_tile "ea05" "(setq PEACE:TAL_AS 1)")
    (action_tile "ea06" "(setq PEACE:TAL_AS 2)")
    (action_tile "ea07" "(setq PEACE:TAL_AS 3)")
    (action_tile "ea08" "(GETDATA)(SaveSysVar)(done_dialog)")
    (action_tile "ea09" "(done_dialog)")
    (start_dialog)
    (unload_dialog dcl_re)
    (vl-file-delete dclname)
    (setq textss (PEACE:Fsxm-ssget "\n>>> 请选择文字或[设置(S)]:" "S" '((0 . "*TEXT"))))
    )
  )
  (princ "\n*** 共选中")
  (princ (sslength textss))
  (princ "个文字图元!\n")
  (setq p1 (getpoint ">>> 指定基线第一点:"))
  (princ p1)
  (princ "\n")
  (setq p2 (getpoint p1 ">>> 指定基线第二点:"))
  (princ p2)
  (princ "\n")
  (if (= PEACE:TAL_P 1)
    (progn
      (setq pnum 1
            tnum1 (- (sslength textss) 1)
            tnum2 (- 1)
      )
    )
    (progn
      (setq pnum (- 1)
            tnum1 0
            tnum2 1
      )
    )
  )
  
  (setq   i 0
        ang (angle p1 p2)
      texth 0
      textd 0
          d (* pnum PEACE:TAL_O)
  )
  (repeat (sslength textss)
    (setq textname (ssname textss (+ tnum1 (* i tnum2)))
           textent (entget textname)
             textt (strcase (cdr (assoc 0 textent)))
                 d (* pnum (+ (* pnum d) texth textd))
    )
    (princ texth)
    (if (= textt "TEXT")
      (if (= PEACE:TAL_P 1)
        (cond
          ((= PEACE:TAL_AS 1) (setq dq1 0 dq2 0 dq3 1))
          ((= PEACE:TAL_AS 2) (setq dq1 0 dq2 1 dq3 1))
          ((= PEACE:TAL_AS 3) (setq dq1 0 dq2 2 dq3 1))
        )
        (cond
          ((= PEACE:TAL_AS 1) (setq dq1 0 dq2 0 dq3 3))
          ((= PEACE:TAL_AS 2) (setq dq1 0 dq2 1 dq3 3))
          ((= PEACE:TAL_AS 3) (setq dq1 0 dq2 2 dq3 3))
        )
      )
      (if (= PEACE:TAL_P 1)
        (cond
          ((= PEACE:TAL_AS 1) (setq dq1 7 dq2 1 dq3 1))
          ((= PEACE:TAL_AS 2) (setq dq1 8 dq2 1 dq3 1))
          ((= PEACE:TAL_AS 3) (setq dq1 9 dq2 1 dq3 1))
        )
        (cond
          ((= PEACE:TAL_AS 1) (setq dq1 1 dq2 1 dq3 1))
          ((= PEACE:TAL_AS 2) (setq dq1 2 dq2 1 dq3 1))
          ((= PEACE:TAL_AS 3) (setq dq1 3 dq2 1 dq3 1))
        )
      )
    )
    ;|(if (= textt "MTEXT")
      (vlax-put-property (vlax-ename->vla-object textname) 'LineSpacingDistance PEACE:TAL_D)
      (setq textent
            (subst
                  (cons 44 (1+ (/ PEACE:TAL_D (cdr (assoc 40 textent)))))
                  (assoc 44 textent)
                  textent
            )
          )
    )|;
    (setq textent
          (subst
                (cons 71 dq1)
                (assoc 71 textent)
                textent
          )
        )
    (setq textent
          (subst
                (cons 72 dq2)
                (assoc 72 textent)
                textent
          )
        )
        (setq textent
          (subst
                (cons 73 dq3)
                (assoc 73 textent)
                textent
          )
        )
        (setq textent
          (subst
                (cons 50 ang)
                (assoc 50 textent)
                textent
          )
        )
        (if (= textt "TEXT")
          (entmod (subst
                        (list 11 (- (car p1) (* (sin ang) d)) (+ (cadr p1) (* (cos ang) d)))
                        (assoc 11 textent)
                        textent
                      )
          )
          (entmod (subst
                        (list 10 (- (car p1) (* (sin ang) d)) (+ (cadr p1) (* (cos ang) d)))
                        (assoc 10 textent)
                        textent
                      )
          )
        )
        (if (null (setq texth (cdr (assoc 43 textent))))
      (setq texth (cdr (assoc 40 textent)))
    )
        (setq i (1+ i) textd PEACE:TAL_D)
  )
  (princ "\n*** 文字齐线完成!")
  (command ".UNDO" "E")
  (PEACE:RestoreSysVarCAD)
  (princ)
)
回复

使用道具 举报

发表于 2014-12-23 09:10 | 显示全部楼层
楼上的贴那么多,还不如贴个链接 http://bbs.mjtd.com/thread-102507-1-1.html
回复

使用道具 举报

 楼主| 发表于 2014-12-24 07:31 | 显示全部楼层
本帖最后由 iszc 于 2014-12-24 07:43 编辑
wzg356 发表于 2014-12-22 23:53
现写的,将就练手

多线段子段点左侧和右侧,文字方向错乱即点左侧实际为点选右侧的效果
如果pline有多个顶点,文字齐线方向好像就不对,能不能换个方向考虑,先选文字,再捕捉点选齐线的两点(文字方向以点选第一点至第二点为方向),最有放置文字位置,这样就完美了,可否帮忙改下

简单的说就是选文字 选线后,文字达到齐线效果,文字放置在线上侧方向为由左至右,文字放置在线下侧方向为由右至左。

by PEACE 2013/07/19 V1.3 修改偏移的bug
这个已用过并说明不符合我要求,谢谢
回复

使用道具 举报

发表于 2014-12-24 12:41 | 显示全部楼层
本帖最后由 wzg356 于 2014-12-24 13:56 编辑
iszc 发表于 2014-12-24 07:31
多线段子段点左侧和右侧,文字方向错乱即点左侧实际为点选右侧的效果
如果pline有多个顶点,文字齐线方向 ...

沙发层功能:文字达到齐线效果,文字与直线角度一致后,想放哪儿就放哪儿。已更新

你的要求应该是下面的这样吧
  1. ;wzg 356 于20141222,20141224改
  2. ;;文字达到齐线效果,文字放置在线上侧方向为由左至右,文字放置在线下侧方向为由右至左。
  3. (defun c:tt4 ( / PickSegEndPt en1 en2 enl1 enl2 p1 p2 p1p2 p3 tmp)
  4. ;;多段线所点击子段的两端点列表,from 明经
  5. (defun PickSegEndPt (obj p / pp n)
  6.   (setq  pp (vlax-curve-getclosestpointto obj (trans p 1 0))
  7.         n  (fix (vlax-curve-getparamatpoint obj pp)))
  8.   (list  (vlax-curve-getPointAtParam obj n)
  9.         (vlax-curve-getPointAtParam obj (1+ n)))
  10. )
  11. (while
  12.   (not(and
  13.         (setq en1 (entsel "\n选择单行文字:"))
  14.         (= (cdr (assoc 0 (setq enl1(entget(car en1))))) "TEXT")
  15.         )
  16.     )        
  17. )
  18. (while
  19.   (not(wcmatch
  20.     (cdr(assoc 0(setq enl2(entget(car (setq en2 (entsel "\n选择要对齐的直线:")))))))
  21.     "*LINE"
  22.     )
  23.   )
  24. )
  25. (if  (= (cdr (assoc 0 enl2)) "LINE")
  26.   (setq p1 (cdr (assoc 10 enl2))
  27.          p2 (cdr (assoc 11 enl2))
  28.     )
  29.     (setq p1p2(PickSegEndPt (car en2) (cadr en2))
  30.           p1 (car p1p2)
  31.           p2 (cadr p1p2)
  32.     )
  33. )
  34. (if(or(> (car p1) (car p2))
  35.     (and
  36.         (equal (car p1) (car p2) 0.00001)
  37.         (> (cadr p1) (cadr p2))
  38.     ))
  39.    (setq tmp p2
  40.          p2  p1
  41.         p1 tmp
  42.     )
  43. )
  44. (setq p3 (cadr en2))
  45. (setq enl1 (subst (cons 50 (angle p1 p2)) (assoc 50 enl1) enl1))
  46. (if (<= (distance p3 p1)(distance p3 p2))
  47.   (setq enl1 (subst (cons 72 0) (assoc 72 enl1) enl1)
  48.         enl1 (subst (cons 73 1) (assoc 73 enl1) enl1)
  49.         enl1 (subst (cons 11 p1) (assoc 11 enl1) enl1)
  50.   )
  51.   (setq enl1 (subst (cons 72 2) (assoc 72 enl1) enl1)
  52.         enl1 (subst (cons 73 3) (assoc 73 enl1) enl1)
  53.         enl1 (subst (cons 11 p2) (assoc 11 enl1) enl1)
  54.   )  
  55. )
  56. (entmod enl1)
  57. (PRINC)
  58. )

复制代码
回复

使用道具 举报

发表于 2014-12-24 12:56 | 显示全部楼层
wzg356 发表于 2014-12-24 12:41
沙发层功能:文字达到齐线效果,文字与直线角度一致后,想放哪儿就放哪儿。已更新

你的要求应该是下面的 ...

应该是基本达到楼主的要求。在我这里测试时,文字角度没问题,文字在上时会偏移开直线很远,文字在下时会紧贴直线。

楼主的“文字放置在线上侧方向为由左至右,文字放置在线下侧方向为由右至左”表示不能理解到底是啥意思。
回复

使用道具 举报

发表于 2014-12-24 22:02 | 显示全部楼层
本帖最后由 wzg356 于 2014-12-24 22:06 编辑

改进7楼的问题,距离根据需要自己调了,有注释
  1. ;wzg 356 于20141222,20141224改
  2. ;;文字达到齐线效果
  3. ;;点击处靠近线左端,则文字放置按左端对齐在线上侧,方向为由左至右(左下对齐)
  4. ;;;点击处靠近线右端,则文字放置按左端对齐在线下侧方向为由右至左(右上对齐)。
  5. (defun c:tt4 ( / PickSegEndPt en1 en2 enl1 enl2 p1 p2 p1p2 p3 tmp)
  6. ;;多段线所点击子段的两端点列表,from 明经
  7. (defun PickSegEndPt (obj p / pp n)
  8.   (setq  pp (vlax-curve-getclosestpointto obj (trans p 1 0))
  9.         n  (fix (vlax-curve-getparamatpoint obj pp)))
  10.   (list  (vlax-curve-getPointAtParam obj n)
  11.         (vlax-curve-getPointAtParam obj (1+ n)))
  12. )
  13. (while
  14.   (not(and
  15.         (setq en1 (entsel "\n选择单行文字:"))
  16.         (= (cdr (assoc 0 (setq enl1(entget(car en1))))) "TEXT")
  17.         )
  18.     )        
  19. )
  20. (while
  21.   (not(wcmatch
  22.     (cdr(assoc 0(setq enl2(entget(car (setq en2 (entsel "\n选择要对齐的直线:")))))))
  23.     "*LINE"
  24.     )
  25.   )
  26. )
  27. (if  (= (cdr (assoc 0 enl2)) "LINE")
  28.   (setq p1 (cdr (assoc 10 enl2))
  29.          p2 (cdr (assoc 11 enl2))
  30.     )
  31.     (setq p1p2(PickSegEndPt (car en2) (cadr en2))
  32.           p1 (car p1p2)
  33.           p2 (cadr p1p2)
  34.     )
  35. )
  36. (if(or(> (car p1) (car p2))
  37.     (and
  38.         (equal (car p1) (car p2) 0.00001)
  39.         (> (cadr p1) (cadr p2))
  40.     ))
  41.    (setq tmp p2
  42.          p2  p1
  43.         p1 tmp
  44.     )
  45. )
  46. (setq p3 (cadr en2))
  47. (setq enl1 (subst (cons 50 (angle p1 p2)) (assoc 50 enl1) enl1))
  48. (if (<= (distance p3 p1)(distance p3 p2))
  49.   (setq ;p1   (polar p1
  50.       ;         (+ (angle p1 p2)(* pi -0.5))
  51.       ;         (/ (cdr (assoc 40 enl1)) 5);这儿调文字距离线的距离
  52.        ;      )
  53.       enl1 (subst (cons 72 0) (assoc 72 enl1) enl1)
  54.         enl1 (subst (cons 73 1) (assoc 73 enl1) enl1)
  55.         enl1 (subst (cons 11 p1) (assoc 11 enl1) enl1)
  56.   )  
  57.   (setq p2   (polar p2
  58.                (+ (angle p2 p1)(* pi 0.5))
  59.                (/ (cdr (assoc 40 enl1)) 4);这儿调文字距离线的距离
  60.              )
  61.         enl1 (subst (cons 72 2) (assoc 72 enl1) enl1)
  62.         enl1 (subst (cons 73 3) (assoc 73 enl1) enl1)
  63.         enl1 (subst (cons 11 p2) (assoc 11 enl1) enl1)
  64.   )  
  65. )
  66. (entmod enl1)
  67. (PRINC)
  68. )

复制代码
回复

使用道具 举报

发表于 2014-12-25 08:18 | 显示全部楼层
wzg356 发表于 2014-12-24 22:02
改进7楼的问题,距离根据需要自己调了,有注释

请教一下
点击处靠近线左端,则文字放置按中间对齐在线上侧,
点击处靠近线右端,则文字放置按中间对齐在线下侧。
如何修改?恳请给予答复,谢谢!
回复

使用道具 举报

发表于 2014-12-25 10:32 | 显示全部楼层
本帖最后由 wzg356 于 2014-12-25 11:06 编辑
香田里浪人 发表于 2014-12-25 08:18
请教一下
点击处靠近线左端,则文字放置按中间对齐在线上侧,
点击处靠近线右端,则文字放置按中间对齐 ...

把最后对齐的两端点改为中点(polar p1 (angle p1 p2)(/ (distance p1 p2) 2))
文字对齐(cons 72 1)(cons 73 1)===中下
文字对齐(cons 72 1)(cons 73 3)===中上
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 16:57 , Processed in 0.203438 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表