找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 444|回复: 4

[LISP程序]:直线上写文本的小程序

[复制链接]
发表于 2003-5-20 10:25:16 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
(mapcar 'setvar '("cmdecho" "highlight") '(0 0))
;(command "layer" "s" "3" "")
;(COMMAND "STYLE" "standard" "" "" "" "" "" "")
(COMMAND "TEXT" "S" "standard" \e)
(prompt "\n功能: 直线上写文本")
(setvar "OSMODE" 0)
(if (= txt_hig nil)
   (Load "txt_hig")
   (PROGN     
         (PRINC "\t文本字高为:  ")(PRINC (/ txt_hig k))(PRINC " [mm]")
   )
);if end
(setq pv nil MD "上" Kzh (/ 180 pi))

(while (and (/= (cadr pv) 13) (/= (cadr pv) 0) (/= (cadr pv) 32) (/= (car pv) 6))
(princ "\n书写位置 '/ '<")(PRINC MD)(princ ">  输入文本<已给文本为: ")
(princ ZXWB)(princ" > 或 选择直线及位置:")
(setq pv (grread))

(if (= (car pv) 2)
(if (and (/= (cadr pv) 13) (/= (cadr pv) 32))
     (if (/= (princ (strcase (chr (cadr pv)))) "/")
       (PROGN
         (setq ZXWB1 (strcat (chr (cadr pv)) (getstring (/= PV nil))))
         (setq ZXWB ZXWB1))
       (setq ZXWB ZXWB1 ZXWB1 "/")
     ) ;if
) ;if
) ;if       
(if (= ZXWB1 "/") (setq ZXWB1 ZXWB md (if (= md "上") "中" "上")))

(if (= (car pv) 3) (progn
  (setq pt (cadr pv) pt1 (osnap pt "nea"))
          (if (not pt1)
                 (setq ag (/ pi 2.) ag1 0 PT1 pt)
                   (setq ag (angle pt1 pt) ag1 (- ag (/ pi 2.)) pt pt1)
          ) ;if

(if (and ag pt ZXWB ZXWB1)
(progn
        (if (and (> ag1 (/ pi -2)) (<= ag1 (/ pi 2.)))
        (PROGN
                (setq ag2 ag1)
                (setq pt (polar pt ag (* K 1.25)))
))
        (if (and (> ag1 (/ pi 2.)) (<= ag1 pi))
        (PROGN
                (setq ag2 (- ag1 pi))
                (setq pt (polar pt ag (+ (* k 0.25) txt_hig)))
))
        (if (and (> ag1 PI) (<= ag1 (* pi 1.5)))
        (PROGN  
                (setq ag2 (- ag1 pi))
                (setq pt (polar pt ag (+ (* k 0.25) txt_hig)))
))
        (if (and (> ag1 (* pi 1.5)) (<= ag1 (* pi 2.)))
        (PROGN  
                (setq ag2 (- ag1 pi))
                (setq pt (polar pt ag (* k 1.25)))
))
        (if (<= ag1 (/ pi -2))
        (PROGN  
                (setq ag2 (- ag1))
                (setq pt (polar pt ag (+ (* k 0.25) txt_hig)))
))
        (if (= MD "上")(PROGN
                        (command "text" "C" pt txt_hig "0" ZXWB)
                        (command "rotate" "L" "" pt (* Kzh ag2))
                        ))
        (if (= MD "中")(PROGN
                        (command "text" "M" pt1 txt_hig "0" ZXWB)
                        (command "rotate" "L" "" pt1 (* Kzh ag2))
                        ))
);PROGN
) ;IF (and ag pt v)
) ;progn
) ;if (= (car pv) 3)
) ;while
(setvar "highlight" 1)
(princ)

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2003-5-29 16:59:02 | 显示全部楼层
能不能详细点,如何使用。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-5-30 00:01:44 | 显示全部楼层
不是应该先要defun一个命令的吗?怎么没找到?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 4个

财富等级: 恭喜发财

发表于 2003-5-30 00:18:27 | 显示全部楼层
而且程序不全
(Load "txt_hig")????
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-5-31 14:21:39 | 显示全部楼层
确实不全!不过自己改吧!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-23 07:34 , Processed in 0.417334 second(s), 39 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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