- 积分
- 63989
- 明经币
- 个
- 注册时间
- 2010-5-9
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 自贡黄明儒 于 2012-8-23 10:21 编辑
我见95%以上的AutoCAD绘图人员(哎,见识太少),字体总是对不齐(嘿嘿,我也是其中之一,说来惭愧!),这要怪Autocad,谁让它不提供对象对齐工具呢(借口还可以吧)?
热心网友提供的文字对齐工具,有些是操作复杂,有些运行慢......总之不符合我的要求。原来写了一个,不能进行文字避让,今有所改善,希望能完美。
运行结果证明,还是有瑕疵,伸出你高贵的手,为了我们共同的目标,完善它,推广它。在此我给菩萨心肠的你鞠躬了。一鞠躬,二鞠躬,三鞠躬......
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun C:ao (/ CMDECHO1 E1 HIG1 HIG2 KEY LIS1
- SS SSET SSETATTDEF SSETCIRCLE SSETINSERT SSETMTEXT SSETTEXT
- )
- ;;2 点表排序
- (defun Sort_X_pList (PLIST / p1 p2)
- (setq plist (vl-sort plist
- '(lambda (p1 p2)
- (cond ((< (car p1) (car p2)) T)
- (T nil)
- )
- )
- )
- )
- )
- ;;3 选择集相减
- (defun SS_SSsub (ss1 ss2 / ss)
- (command "._Select" ss1 "_Remove" ss2 "")
- (if (equal (sslength ss1) (sslength ss2))
- nil
- (setq ss (ssget "_P"))
- )
- )
- ;;4 获取对象的外边框
- (defun HH:MinMaxPt (ent / MinPt MaxPt)
- (vla-GetBoundingBox
- (vlax-Ename->vla-Object ent)
- 'MinPt
- 'MaxPt
- )
- (mapcar 'vlax-safearray->list (list MinPt MaxPt))
- )
- ;;5 处理列******************************************************
- ;; 左中 中中对齐方式有效
- ;; Mtext code=10,其余code=11
- (defun TextInSameCol (ss code hig1 / E1 E2 H I LIS1
- LIS2 LISTMINUS LISTPLUS N P1 P2 elist
- SS1 WID WID1 WID2 Y
- )
- (setq e1 (ssname ss 0))
- (setq SS1 (ssadd e1 (ssadd)))
- (setq lis1 (HH:MinMaxPt e1))
- (setq wid1 (- (car (cadr lis1)) (car (car lis1))))
- (setq p1 (cdr (assoc code (entget e1))))
- (setq n 0)
- (repeat (1- (sslength ss))
- (setq e2 (ssname ss (setq n (1+ n))))
- (setq lis2 (HH:MinMaxPt e2))
- (setq wid2 (- (car (cadr lis2)) (car (car lis2))))
- (setq p2 (cdr (assoc code (entget e2))))
- (setq H (- (cadr p2) (cadr p1)))
- (setq wid (< (abs (- (car p1) (car p2))) (/ (+ wid1 wid2) 2.0)))
- (if wid
- (progn
- (setq SS1 (ssadd e2 ss1))
- (if (> H 0)
- (setq ListPlus (cons (list H e2) ListPlus))
- (setq ListMinus (cons (list H e2) ListMinus))
- )
- )
- )
- )
- (setq ListPlus (Sort_X_pList ListPlus))
- (setq ListMinus (reverse (Sort_X_pList ListMinus)))
- (setq i 0)
- (setq n (length ListPlus))
- (if ListPlus
- (repeat n
- (setq i (1+ i))
- (setq e2 (cadr (car ListPlus)))
- (setq ListPlus (cdr ListPlus))
- (setq p2 (cdr (assoc code (entget e2))))
- (setq y (- (cadr p2) (cadr p1)))
- (if (> (setq y (fix (+ (/ y hig1) 0.5))) i)
- (setq i y)
- )
- (setq elist (entget e2))
- (setq p2 (list (car p1) (+ (cadr p1) (* i hig1)) 0.0))
- (entmod (subst (cons code p2) (assoc code elist) elist))
- )
- )
- (setq i 0)
- (setq n (length ListMinus))
- (if ListMinus
- (repeat n
- (setq i (1+ i))
- (setq e2 (cadr (car ListMinus)))
- (setq ListMinus (cdr ListMinus))
- (setq p2 (cdr (assoc code (entget e2))))
- (setq y (- (cadr p1) (cadr p2)))
- (if (> (setq y (fix (+ (/ y hig1) 0.5))) i)
- (setq i y)
- )
- (setq elist (entget e2))
- (setq p2 (list (car p1) (- (cadr p1) (* i hig1)) 0.0))
- (entmod (subst (cons code p2) (assoc code elist) elist))
- )
- )
- (setq ss (SS_SSsub ss ss1))
- (if ss
- (TextInSameCol ss code hig1)
- )
- )
- ;;6 Y间距<行间距hig1,认为在同一行,则使其在x向对齐**********************
- ;; 左中 中中对齐方式有效
- ;; Mtext code=10,其余code=11
- ;;(setq ss (ssget) code 11 hig1 7)
- (defun TextInSameRow (ss code hig1 / E1 E2 H N P1 P2 SS1 elist)
- (setq e1 (ssname ss 0))
- (setq SS1 (ssadd e1 (ssadd)))
- (setq p1 (cdr (assoc code (entget e1))))
- (setq n 0)
- (repeat (1- (sslength ss))
- (setq e2 (ssname ss (setq n (1+ n))))
- (setq p2 (cdr (assoc code (entget e2))))
- (setq H (abs (- (cadr p1) (cadr p2))))
- (if (< (abs H) hig1)
- (progn (setq SS1 (ssadd e2 ss1))
- (setq elist (entget e2))
- (setq p2 (list (car p2) (cadr p1) 0.0))
- (entmod (subst (cons code p2) (assoc code elist) elist)) ;在Y向移动
- )
- )
- )
- (setq ss (SS_SSsub ss ss1))
- (if ss
- (TextInSameRow ss code hig1)
- )
- )
- ;;7 主程序
- (if (cadr (ssgetfirst))
- (setq
- sSet (ssget "_P"
- '((0 . "*TEXT,ATTDEF,CIRCLE,ARC,ELLIPSE,INSERT"))
- )
- )
- )
- (princ "\n 单行文字、多行文字、块、圆依次择其一类对齐")
- (if sSet
- nil
- (setq
- sSet (ssget '((0 . "*TEXT,ATTDEF,CIRCLE,ARC,ELLIPSE,INSERT")))
- )
- )
- (vl-load-com)
- (command "undo" "be")
- (setq cmdecho1 (getvar "cmdecho"))
- (setvar "cmdecho" 0)
- (command "._Select" sSet "")
- (setq sSetText (ssget "_p" '((0 . "TEXT"))))
- (command "._Select" sSet "")
- (setq sSetMText (ssget "_p" '((0 . "MTEXT"))))
- (command "._Select" sSet "")
- (setq sSetATTDEF (ssget "_p" '((0 . "ATTDEF"))))
- (command "._Select" sSet "")
- (setq sSetCIRCLE (ssget "_p" '((0 . "CIRCLE,ARC,ELLIPSE"))))
- (command "._Select" sSet "")
- (setq sSetINSERT (ssget "_p" '((0 . "INSERT"))))
- (if (or sSetText sSetMText sSetATTDEF)
- (progn (initget "mC mL") ;区分大小写
- (setq key (getkword "\n文本对齐于 [正中(C)/左中(L)]:<C>"))
- (if (not key)
- (setq key "MC")
- )
- (setq key (strcase key))
- (command "_.JUSTIFYTEXT" sSetText "" key)
- )
- )
- (cond (sSetText (setq ss sSetText))
- (sSetMText (setq ss sSetMText))
- (sSetATTDEF (setq ss sSetATTDEF))
- (sSetINSERT (setq ss sSetINSERT))
- (sSetCIRCLE (setq ss sSetCIRCLE))
- )
- (setq e1 (ssname ss 0))
- (setq lis1 (HH:MinMaxPt e1))
- (initget 46)
- (setq hig2 (* 2.0 (- (cadr (cadr lis1)) (cadr (car lis1)))))
- (setq
- hig1 (getreal (strcat "\n >>输入行间距<" (rtos hig2 2 3) ">:"))
- )
- (if hig1
- nil
- (setq hig1 hig2)
- )
- (cond (sSetText
- (TextInSameRow sSetText 11 hig1)
- (TextInSameCol sSetText 11 hig1)
- )
- (sSetMText
- (TextInSameRow sSetMText 10 hig1)
- (TextInSameCol sSetMText 10 hig1)
- )
- (sSetATTDEF
- (TextInSameRow sSetATTDEF 11 hig1)
- (TextInSameCol sSetATTDEF 11 hig1)
- )
- (sSetINSERT
- (TextInSameRow sSetINSERT 10 hig1)
- (TextInSameCol sSetINSERT 10 hig1)
- )
- (sSetCIRCLE
- (TextInSameRow sSetCIRCLE 10 hig1)
- (TextInSameCol sSetCIRCLE 10 hig1)
- )
- )
- (setvar "cmdecho" cmdecho1)
- (command "undo" "END")
- (princ)
- )
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
mccad给予好评了,怎么也得将代码优化一下,见压缩文件
优化方法http://bbs.mjtd.com/thread-93264-1-1.html
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
评分
-
查看全部评分
|