[求助这样一个程序。
能够对文字也可以使用offset程序。就相当于offset直线一样，平行于原文字方向copy一定距离复制文字
由于图形中文字经常不是垂直相交，我现在采用复制文字的方式是先旋转坐标轴，ucs后让坐标轴平行于文字后在复制，感觉很麻烦，希望能有朋友帮助编辑这样一个程序，提高效率 试一下下面的程序：[ code];明经 2005.4.29 --- ZZXXQQ(DEFUN C:TXTOF ()
(SETVAR "CMDECHO" 0)
(SETQ OF (GETVAR "USERR3"))
(PRINC "\nOffset distance or Through <")
(PRINC (IF (= OF 0) "Trough" OF))
(INITGET "Trough" 0)
(SETQ D (GETDIST "> :")
D (IF (= D nil) OF D)
OF (IF (= D "Trough") 0.0 D))
(SETVAR "USERR3" OF)
(IF (SETQ S1 (ENTSEL "\nSelect Text to offset : ")) (PROGN
(COMMAND ".UNDO" "BE")
(SETQ SS (CAR S1)
PT1 (CADR S1)
OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(SETQ ENT (ENTGET SS))
(WHILE (/= (CDR (ASSOC 0 ENT)) "TEXT")
(PRINC "\nCannot offset that object.")
(IF (SETQ S1 (ENTSEL "\nSelect Text to offset : "))
(SETQ SS (CAR S1) PT1 (CADR S1) ENT (ENTGET SS))
)
)
(REDRAW SS 3)
(SETQ PT (GETPOINT (IF (= OF 0) "\nThrough point:" "\nSide to offset?")))
(IF PT (PROGN
(SETQ TB (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
ANG (CDR (ASSOC 50 ENT))
ANG (IF (> ANG PI) (- ANG PI PI) ANG)
A1 (+ (* PI 0.5) ANG)
A3 (- ANG (* PI 0.5))
AN1 (ANGLE PT1 PT))
(IF (= OF 0)
(SETQ PT1 (CDR (ASSOC 10 ENT))
AN2 (ANGLE PT1 PT)
DS (* (SIN (- AN2 ANG)) (DISTANCE PT1 PT))
PT (POLAR PT1 (IF (EQUAL AN2 A1 (* PI 0.5)) A1 A3) DS))
(SETQ PT (POLAR PT1 (IF (EQUAL AN1 A1 (* PI 0.5)) A1 A3) OF))
)
(COMMAND "COPY" SS "" PT1 PT)
))
(SETVAR "OSMODE" OLDOS)
(REDRAW SS 4)
(COMMAND ".UNDO" "E")
))
(PRINC)
)
非常感谢zzxxqq，这个问题解决了
希望继续来个另外的功能，就是垂直于文字方向移动
起目的就是ofset后删除原来的那个文字，就达到移动的目的了 您只要将2楼程序中的COPY命令改为MOVE命令即可达到移动的目的了。 能说说把这些程序放哪里吗 放在磁盘上的任何地方。只要文件扩展名为.LSP就行。 呵呵
同意楼上做法
页:
[1]