[求助]文字和直线平行 - 编程申请 - AutoCAD论坛 - 明经CAD社区 - 第2页

wedg 发表于 2004-6-26 13:08:00

六楼的程序中，在输入文字的时候，不能有空格符，如果文字有空格的话，就需要用编辑文字的命令重新在文字中插入空格，这样很麻烦。能否改进一下？

小妹丁 发表于 2004-6-26 20:42:00

(defun c:ltext () (setq en (car (entsel "\n选取线："))) (setq endata (entget en)) (setq pt1 (cdr (assoc 10 endata))) (setq pt2 (cdr (assoc 11 endata))) (setq ang1 (/ (* (angle pt1 pt2) 180) pi)) (setq str (getstring T "\n输入字符：")) (setq strh (getreal "\n输入字高：")) (setq pt (getpoint "\n指定位置：")) (command "text" pt strh ang1 str) )

这样子，就可以输入空格。

wedg 发表于 2004-6-26 23:37:00

好，多谢！

叶文军 发表于 2004-8-24 11:06:00

可以按照图中的意思写出来吗?

按照图中的意思可以实现吗?

xyp1964 发表于 2004-8-30 02:12:00

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;pxxz.lsp 平行旋转 ;;;* C:pxxz ;;;-- <A href="mailto:XYP@bsedi.com" target="_blank" >XYP@bsedi.com</A> ;;;2004.08.29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (prompt "\n\r 加载平行旋转程序。") ;------------------------------------------- ;;;主程序 (DEFUN C:pxxz (/ s1 en pt1 ang th old new) (cmdla0) (SETQ S1 (entsel "\n\t选择旋转文字：") s1 (entget (car S1)) ) (while (/= (dxf 0 s1) "TEXT");确认是文本 (princ (dxf 0 s1)) (SETQ S1 (entsel "\n\t选择旋转文字：") s1 (entget (car S1)) ) ) (setq en (entsel "\n\t选择定位线 : ") pt1 (cadr en);定位点 ang (angle (ddxf 10 en)(ddxf 11 en));线角度 th (dxf 40 s1);字高 pt1 (polar pt1 (+ (/ pi 2) ang)(/ th 1.25));定位点 ;h (dxf 40 s1);字高 ) (if s1 (progn (SETQ OLD (assoc 50 s1)) (SETQ NEW (CONS 50 ang)) (SETQ S1 (SUBST NEW OLD s1)) (ENTMOD S1) (SETQ OLD (assoc 11 S1)) (SETQ NEW (CONS 11 pt1)) (SETQ S1 (SUBST NEW OLD S1)) (ENTMOD S1) ) ) (princ) (cmdla1) (PXYP "PXXZ (平行旋转)") );defun

 ;;;------------------------------------------- ;;;子程序 ;;; (defun CMDLA0 () (setq cmdech (GETVAR "CMDECHO")) (setq oom (getvar "orthomode")) (setq osm (getvar "osmode")) (SETQ LA (getvar "clayer")) (setvar "regenmode" 1) (SETVAR "CMDECHO" 0) )

;;; (defun CMDLA1 () (SETVAR "CMDECHO" cmdech) (setvar "orthomode" oom) (setvar "osmode" osm) (setvar "clayer" LA) (setvar "regenmode" 1) )

;;; (defun ureal (bit kwd msg def / inp) (if def (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ") bit (* 2 (fix (/ bit 2))) ) (setq msg (strcat "\n" msg ": ")) ) (initget bit kwd) (setq inp (getreal msg)) (if inp inp def) )

;;; (Defun MKLA (a b) (If (= (Tblsearch "layer" a) nil) (Command "layer" "m" a "c" b a "") (Command "layer" "t" a "s" a "c" b a "") ) )

;;; ; ----------------------- DXF -------------------------- (defun dxf (code elist) (cdr (assoc code elist))) (defun dxf-s1(code elist) (dxf code (entget elist))) (defun ddxf (code elist) (dxf code (entget (car elist))))

;;; (DEFUN PXYP (TXT1) (SETQ TXT1 (STRCAT "\n\r 程序命令: " TXT1 " -- <A href="mailto:XYP@bsedi.com" target="_blank" >XYP@bsedi.com</A>")) (PRINC TXT1) (Princ) );defun

;;; (PXYP "PXXZ (平行旋转)") (princ) ;------------------------------------------- ;;;END

f5612140 发表于 2004-8-30 17:21:00

TEXT本身自带此功能

zwqgdhl 发表于 2011-7-12 16:09:03

好的创意，先下载了再研究

zhouyxcs 发表于 2011-12-3 16:03:20

给个思路：先写字，然后在字下面加上下划线。这样美观、统一。

GamIng 发表于 2011-12-12 15:14:51

;;;;文字方向匹配
(defun c:FX (/ smd gmd ent text_ang ent_list)
(setq smd (getvar "snapmode")
gmd (getvar "gridmode")
)
(command "snapmode" "0")
(command "gridmode" "0")
(princ "\n选择源物体:")
(command "ucs" "ob" pause)
(setvar "UCSICON" 0)
(if (setq ent (entsel "选择目标文字:")
   )
(progn
   (setq text_ang (angle '(0 0 0) (getvar "UCSXDIR")))
   (while (> text_ang (/ pi 2))
(setq text_ang (- text_ang pi))
   )
   (setq ent_list (entget (car ent)))
   (setq ent_list (subst (cons 50 text_ang)
   (assoc '50 ent_list)
   ent_list
      )
   )
   (entmod ent_list)
)
)
(setvar "UCSICON" 1)
(command "ucs" "p")
(setvar "snapmode" smd)
(setvar "gridmode" gmd)
(princ)
)
;;;结束

sotop 发表于 2013-4-27 01:03:35

很好用，我试过了。

页: 1 [2]

明经CAD社区's Archiver

可以按照图中的意思写出来吗?