框选写入文字功能（实用）
本帖最后由 【KAIXIN】 于 2011-12-2 16:21 编辑如果觉得框选的宽与高不合适可以用下面的程序（刷一下）：
框选写入文字功能，学习了！ 好東西，謝謝分享，感謝!!! 感谢作者的分享！ 晕倒哦，楼主购买主题一个，附件还要一个啊 本帖最后由 【KAIXIN】 于 2011-12-2 16:16 编辑
hao3ren 发表于 2011-12-2 16:09 http://bbs.mjtd.com/static/image/common/back.gif
晕倒哦，楼主购买主题一个，附件还要一个啊
哈哈不好意思！看错了，第一次收钱，我改改！ 理解错误，以为是在原有文字框选位置处写入文字，实际上就是写文字，这样写文字的字高怎么控制啊 hao3ren 发表于 2011-12-2 16:14 static/image/common/back.gif
理解错误，以为是在原有文字框选位置处写入文字，实际上就是写文字，这样写文字的字高怎么控制啊
字高在框选的时候就可以控制 hao3ren 发表于 2011-12-2 16:14 static/image/common/back.gif
理解错误，以为是在原有文字框选位置处写入文字，实际上就是写文字，这样写文字的字高怎么控制啊
我上传了一个文字高宽比，可以设置文字的默认样子...... 本帖最后由 【KAIXIN】 于 2011-12-2 16:27 编辑
;修改字高
(DEFUN changtextheight (EN TCH_ok / th1 aa1)
(if b
(progn
(setq kk 0)
(setq ss "\n新字高<")
(SETQ TH (CDR (ASSOC 40 EN)))
(if tch_ok
(progn
(setq th1 (rtos (* th scale_47) 2 2))
(setq th (* th scale_47))
)
(setq th1 (rtos (/ th 1) 2 2))
)
(princ (strcat ss th1 "mm>:"))
(setq aa1 (getreal))
(if aa1
(setq th (* aa1 1))
)
(setq b nil)
)
)
(if TCH_ok
(progn
(setq th (/ th scale_47))
(setq en (subst (cons 40 th) (assoc 40 en) en))
(setq th (* th scale_47))
)
(setq en (subst (cons 40 th) (assoc 40 en) en))
)
(entmod en)
(setq kk (1+ kk))
)
******************************************************
(defun C:CH (/ LL EN k kk th b)
(setq sse (ssget))
(if sse
(progn
(setq ll (sslength sse)
b0
k0
kk 0
)
(repeat ll
(SETQ EN (ENTGET (ssname sse k)))
(setq TCH_ok nil)
(if (= (CDR (ASSOC 0 EN)) "TEXT")
(changtextheight en TCH_ok)
(if (= (CDR (ASSOC 0 EN)) "TCH_TEXT")
(progn
(setq scale_47 (cdr (assoc 47 en)))
;(setq en (subst (cons 72 11) (assoc 72 en) en))
(setq TCH_ok 0)
(changtextheight en TCH_ok)
)
)
) ;if text_end
(if (= (CDR (ASSOC 0 EN)) "INSERT")
(progn
(setq main_B_name (cdr (assoc -1 en)))
(setq an (tblsearch "block" (cdr (assoc 2 en))))
(setq an_name (cdr (assoc -2 an)))
(while (/= an_name nil)
(setq en (entget an_name))
(if (= (CDR (ASSOC 0 EN)) "TEXT")
(progn
(changtextheight en TCH_ok)
)
)
(setq an_name (entnext an_name))
)
(entupd main_B_name)
)
) ;if_insert_end
(setq k (1+ k))
) ;repeat_end
(princ (strcat "改了" (rtos kk) "个字符."))
)
)
(PRINC)
)
**************************************************
(defun C:CW (/ p l n nw chm en ow enm e1)
(setq p (ssget))
(if p (progn
(setq l 0 n (sslength p) chm 0)
(while (< l n)
(setq enm (cdr (assoc 0 (setq en (entget (ssname p l))))))
(if(or (= enm "LWPOLYLINE") (= enm "POLYLINE") (= enm "LINE") (= enm "ARC")(= enm "CIRCLE"))
(progn
(if (zerop chm) (progn
(if (and (/= enm "LINE") (/= enm "ARC")) (setq ow (cdr (assoc 40 en)))
(setq ow 0))
(princ "\n新线宽<")
(princ (rtos (/ ow 1) 2 2))
(setq nw (getreal "mm>:"))
(if (null nw) (setq nw ow))
))
(if (= enm "CIRCLE")
(progn
;(setq angle1 (/ pi 2))
(setq pt1 (polar (CDR(ASSOC 10 EN)) 0 (CDR(ASSOC 40 EN))))
(setq pt2 (polar (CDR(ASSOC 10 EN)) pi (CDR(ASSOC 40 EN))))
(command ".BREAK" pt1 pt2)
(command "pedit" (ssname p l) "y" "w" nw "c" "")
))
(if (or (= enm "LINE") (= enm "ARC"))
(command "pedit" (ssname p l) "y" "w" nw "")
(if (or(= enm "LWPOLYLINE") (= enm "POLYLINE"))
(command "pedit" (ssname p l) "w" nw "")
)
)
(setqchm (1+ chm))
))
(setq l (1+ l))
)
))
(princ "改了") (princ chm) (princ "条线.")
(PRINC)
)
;(command ".BREAK"
; (cons e
; (polar (socas 10) 0 (socas 40))
; )
; (polar (socas 10) 1e-3 (socas 40)) 这个功能是最基本的，我以前弄得也有，理解错误了，呵呵呵，说实话这个源码收费有点坑人了 hao3ren 发表于 2011-12-2 16:27 static/image/common/back.gif
这个功能是最基本的，我以前弄得也有，理解错误了，呵呵呵，说实话这个源码收费有点坑人了
嗯，其实这个是我很常用的一个程序，工作需要特意写的，顺便分享！
可以框选一个表格，或者一个框来写文本，文本的内容可以任意......... 实用性不是很大，每次框选的不可能一样大