设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [LISP程序]：我们装cad后在acad.lsp中必加的一段程序 ...
12下一页
返回列表 发新帖
查看: 1763|回复: 20

[LISP程序]：我们装cad后在acad.lsp中必加的一段程序

[复制链接]
gjliang
发表于 2003-3-13 21:42:37 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
  2. (defun C:CH (/ LL EN KK K B TH AA)
  3.     (setq sse (ssget))
  4.     (if sse (progn
  5.        (setq ll (sslength sse) k 0 b 0 kk 0)
  6.        (repeat ll
  7.          (SETQ EN (ENTGET (ssname sse k)))
  8.          (if (= (CDR (ASSOC 0 EN)) "TEXT") (PROGN
  9.             (IF B (PROGN
  10.             (SETQ TH (CDR (ASSOC 40 EN)))
  11.                (princ (setq ss "\n新字高<"))
  12.                (princ (rtos (/ th 1) 2 2))
  13.                (setq aa (getreal "mm>:"))
  14.                (if aa (setq th (* aa 1)))
  15.                (setq b nil)
  16.             ))
  17.             (setq en (subst (cons 40 th) (assoc 40 en) en))
  18.             (entmod en)
  19.             (setq kk (1+ kk))
  20.          ))   ; if text
  21.          (setq k (1+ k))
  22.        )   ;
  23.      ))
  24.       (princ "改了") (princ kk) (princ "个字符.")
  25.       (PRINC)
  26. )

  28. (DEFUN C:ZW ()
  29.      (COMMAND "ZOOM" "W")
  30. )
  31. (DEFUN C:ZP ()
  32.      (COMMAND "ZOOM" "P")
  33. )(DEFUN C:ZA ()
  34.      (COMMAND "ZOOM" "A")
  35. )
  36. (defun c:zd ()
  37.      (command "ZOOM" "D")
  38. )
  39. (defun c:ze ()
  40.           (command "zoom" "e")
  41. )
  42. (defun C:CW (/ p l n nw chm en ow enm)
  43.       (setq p (ssget))
  44.       (if p (progn
  45.         (setq l 0 n (sslength p) chm 0)
  46.         (while (< l n)
  47.           (setq enm (cdr (assoc 0 (setq en (entget (ssname p l))))))
  48.           (if(or (= enm "LWPOLYLINE") (= enm "POLYLINE") (= enm "LINE") (= enm "ARC"))
  49.              (progn
  50.                (if (zerop chm) (progn
  51.                (if (and (/= enm "LINE") (/= enm "ARC")) (setq ow (cdr (assoc 40 en)))
  52.                    (setq ow 0))
  53.                 (princ "\n新线宽<")
  54.                 (princ (rtos (/ ow 1) 2 2))
  55.                 (setq nw (getreal "mm>:"))
  56.                 (if (null nw) (setq nw ow))
  57.               ))
  58.            (if (or (= enm "LINE") (= enm "ARC")) (command "pedit" (ssname p l) "y" "w" nw "")
  59.            (command "pedit" (ssname p l) "w" nw ""))
  60.               (setq  chm (1+ chm))
  61.           ))
  62.           (setq l (1+ l))
  63.         )
  64.       ))
  65.       (princ "改了") (princ chm) (princ "条线.")
  66.       (PRINC)
  67. )
  68. ; 以下为自动加载文件选项
setq, princ, COMMAND

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

前生

已领礼包: 8个

财富等级: 恭喜发财
发表于 2003-3-14 11:50:07 | 显示全部楼层
  2. (Defun c:za ()
  3.   (Defun mmy (ben / count doc handles l1 l2 count y1 y2)
  4.     (setq count 0)
  5.     (setq lyx nil)
  6.     (setq lyy nil)
  7.     (SetQ doc (VLA-Get-ActiveDocument (VLAX-Get-ACAD-Object)))
  8.     (while (< count (sslength ben))
  9.       (setq ent1 (ssname ben count))
  10.       (SetQ
  11.         handles
  12.          (Cdr (Assoc 5 (EntGet ent1)))
  13.       )
  14.       (VLA-GetBoundingBox
  15.         (VLA-HandleToObject doc handles)
  16.         'llp
  17.         'urp
  18.       )
  19.       (setq l1 (VLAX-SafeArray->List llp))
  20.       (setq lyx (cons (Car l1) lyx))
  21.       (setq lyy (cons (Cadr l1) lyy))
  22.       (setq l2 (VLAX-SafeArray->List urp))
  23.       (setq lyx (cons (Car l2) lyx))
  24.       (setq lyy (cons (Cadr l2) lyy))
  25.       (setq count (1+ count))
  26.     )
  27.     (setq lyx (vl-sort lyx '<))
  28.     (setq lyy (vl-sort lyy '<))
  29.   )
  30.   (setq ss nil)
  31.   (prompt "\n 请选取需要全屏幕放大的实体:...")
  32.   (setq ss (ssget))
  33.   (if ss
  34.     (progn
  35.       (mmy ss)
  36. ;;;      (setq x1 (nth 0 lyx)
  37. ;;;            x2 (last lyx)
  38. ;;;      )
  39. ;;;      (setq y1 (nth 0 lyy)
  40. ;;;            y2 (last lyy)
  41. ;;;      )
  42.       (command "zoom"
  43.                (trans (list (nth 0 lyx) (nth 0 lyy)) 0 1)
  44.                (trans (list (last lyx) (last lyy)) 0 1)
  45.       )
  46.     )
  47.     (prompt "\n 没有选取到实体!")
  48.   )
  49.   (princ)
  50. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

舞步
发表于 2003-3-14 21:55:30 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
为什么必加？能否讲一下呀？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

gjliang
 楼主| 发表于 2003-3-14 22:56:26 | 显示全部楼层
因为一个是字的编辑命令，一个是线的编辑程序，对文字大小和线的粗细都是很有用的，听前辈们说现在没有这几个命令，用cad绘图还真不方便，文字编辑命令是：ch 线的命令是：cw
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ljb
发表于 2003-3-15 00:07:59 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
暂时还看不明白，能否吧功能讲具体一点？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

gjliang
 楼主| 发表于 2003-3-15 13:38:26 | 显示全部楼层
就是把这段程粘贴到acaddoc.lisp里，启动cad2002时就可以使用了，键入ch命令表示修改字高，键入cw表示修改线宽，很方便的，不用在打开属性对话框来修改了，至于zw，za，ze命令则是把z命令的综合而已，很方便的，放大图形时就不用输入命令后在选其他选项了，这是前辈在很就以前写的一个程序，我们用着觉得不错，对快速修改字高和线粗很方便的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

dys800113
发表于 2003-3-15 15:44:44 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 前生 发布
[B][code](Defun c:za ()
  (Defun mmy (ben / count doc handles l1 l2 count y1 y2)
    (setq count 0)
    (setq lyx nil)
    (setq lyy nil)
    (SetQ doc (VLA-Get-ActiveDocument (VLAX-Get-ACAD-Object)... [/B]

这个是用在什么方面的lisp？[/COLOR]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

前生

已领礼包: 8个

财富等级: 恭喜发财
发表于 2003-3-15 16:08:27 | 显示全部楼层

选择实体后。以实体的最大外接矩形进行zoom.

最初由 dys800113 发布
[B][QUOTE]最初由 前生 发布
[B][code](Defun c:za ()
  (Defun mmy (ben / count doc handles l1 l2 count y1 y2)
    (setq count 0)
    (setq lyx nil)
    (setq lyy nil)
    (SetQ doc (VLA-Get-Ac... [/B]


试一下就知道了，
选择实体后。以实体的最大外接矩形进行zoom.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

dys800113
发表于 2003-3-15 16:55:13 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
不行啊！提示：
Command: za
请选取需要全屏幕放大的实体:...
Select objects: 1 found

Select objects:
error: null function
(VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT))
(SETQ DOC (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
(MMY SS)
(PROGN (MMY SS) (COMMAND "zoom" (TRANS (LIST (NTH 0 LYX) (NTH 0 LYY)) 0 1)
(TRANS (LIST (LAST LYX) (LAST LYY)) 0 1)))
(IF SS (PROGN (MMY SS) (COMMAND "zoom" (TRANS (LIST (NTH 0 LYX) (NTH 0 LYY)) 0
1) (TRANS (LIST (LAST LYX) (LAST LYY)) 0 1))) (PROMPT "\n 没有选取到实体!"))
(C:ZA)
*Cancel*
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

前生

已领礼包: 8个

财富等级: 恭喜发财
发表于 2003-3-15 17:35:41 | 显示全部楼层
(VL-LOAD-COM)事先运行或加在程序的首行.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

hi71400
发表于 2003-3-15 17:54:24 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
两条意见，一个建议。
1，对R14用户而言，很少装Vlisp
2，加粗命令cw不能加圆圈。
建议：改字高除了给出字高外，可以考虑对选定的字的原字高乘上某个比例。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

dys800113
发表于 2003-3-15 19:53:19 | 显示全部楼层
最初由 hi71400 发布
[B]两条意见，一个建议。
1，对R14用户而言，很少装Vlisp
2，加粗命令cw不能加圆圈。
建议：改字高除了给出字高外，可以考虑对选定的字的原字高乘上某个比例。 [/B]

[B]改变圆的粗度改怎么办呢？[/COLOR] [/B]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

gjliang
 楼主| 发表于 2003-3-16 00:03:36 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
lisp我也是只会用的，因为这几天在看关于lisp方面的书，所以把原来的前辈写的一段程序拿了出来，我想问一个问题，就是我vba写了个程序，请问怎样用lisp对其自动加载呢，还有就是菜单文件能用lisp来加载吗？谢谢指点。
setq, princ, COMMAND

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

dys800113
发表于 2003-3-16 12:21:55 | 显示全部楼层
最初由 前生 发布
[B](VL-LOAD-COM)事先运行或加在程序的首行. [/B]

能否讲详细一点，我还是用不起来？[/COLOR]

你用acad2000＋试试。应该可以用的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ljb
发表于 2003-3-16 14:48:22 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
上面的功能晓东工具箱好像也有啊。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2025-9-27 06:54 , Processed in 0.195259 second(s), 62 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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