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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：加粗线段的记忆功能为何无法使用？ ...
返回列表 发新帖
查看: 1017|回复: 7

[求助] [求助]：加粗线段的记忆功能为何无法使用？

[复制链接]
cdlh
发表于 2006-11-21 10:46:28 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
在网上下载了一个加粗线段的 LISP ，作者称有输入数值记忆功能，但我使用时却没有，是何原因？

  3.   [FONT=courier new]
  4.     ;;;  该程序可修改线,弧,圆及多义线的宽度
  5. (defun C:xk (/ p l n e q w a m b  layer0 color0 linetype0 layer1 color1 linetype1 rad-out rad-in)
  6.   (setq oldblp (getvar "blipmode")
  7.         oldech (getvar "cmdecho")
  8.         olderr *error*
  9.         linetype1 (getvar "celtype")
  10.         layer1 (getvar "clayer")
  11.         color1 (getvar "cecolor")
  12.   )
  13.   (setvar "blipmode" 0)
  14.   (setvar "cmdecho" 0)
  15.   (defun *error* (msg)
  16.     (princ "\n")
  17.     (princ msg)
  18.     (setvar "blipmode" oldblp)
  19.     (setvar "cmdecho" oldech)
  20.     (setq *error* olderr)
  21.     (princ)
  22.   )  
  23.   (prompt "\n请选择要改变宽度的线,弧,圆及多义线.")
  24.   (setq p (ssget))
  25.   (if (= w nil) (setq w 50))
  26. (setq width (getreal (strcat "\n请输入宽度<" (rtos W) ">: ")))
  27.   (if (= width nil) (setq width w))
  28.   (setq l 0 m 0 n (sslength p))
  29.   (while (< l n)
  30.     (setq q (ssname p l))
  31.     (setq ent (entget q))
  32.     (setq b (cdr (assoc 0 ent)))
  33.     (if (member b '("LINE" "ARC"))
  34.       (progn
  35.         (command "PEDIT" q "y" "w" width "x")
  36.         (setq m (+ 1 m))
  37.       )
  38.     )
  39.     (if (= "LWPOLYLINE" b)
  40.       (progn
  41.         (command "PEDIT" q "w" width "x")
  42.         (setq m (+ 1 m))
  43.       )
  44.     )
  45.     (if (= "CIRCLE" b)
  46.       (progn
  47.         (if (assoc 6 ent) (setq linetype0 (cdr (assoc 6 ent))) (setq linetype0 "bylayer"))
  48.         (setq layer0 (cdr (assoc 8 ent)))
  49.         (if (assoc 62 ent) (setq color0 (cdr (assoc 62 ent))) (setq color0 "bylayer"))
  50.         (setq center0 (cdr (assoc 10 ent)))
  51.         (setq radius0 (cdr (assoc 40 ent)))
  52.         (setq diameter0 (* 2 radius0))
  53.         (entdel q)
  54.         (command "color" color0)
  55.         (command "layer" "s" layer0 "")
  56.         (command "linetype" "s" linetype0 "")
  57.         (if (> w diameter0)
  58.           (progn
  59.             (princ "\n\t 因线宽大于圆的直径，故将该圆填充")
  60.             (princ)
  61.             (setq rad-out (* 2 radius0)
  62.                   rad-in 0
  63.             )
  64.           )
  65.         )
  66.         (if (<= w diameter0)
  67.           (progn
  68.             (setq rad-out (+ (* 2 radius0) width)
  69.                   rad-in (- (* 2 radius0) width)
  70.             )
  71.           )
  72.         )
  73.         (command "donut" rad-in rad-out center0 "")
  74.         (setq m (+ 1 m))
  75.       )
  76.     )
  77.     (setq l (+ 1 l))
  78.   )
  79.   (if (= 0 m)
  80.     (progn
  81.      (princ "\n\t  没有任何线,弧,圆及多义线被选中")
  82.       (princ)
  83.     )
  84.   )
  85.   (setvar "blipmode" oldblp)
  86.   (setvar "cmdecho" oldech)
  87.   (setq *error* olderr)
  88.   (command "color" color1)
  89.   (command "layer" "s" layer1 "")
  90.   (command "linetype" "s" linetype1 "")
  91.   (princ)
  92. )
  93. (princ)

  95.   [/FONT]
setq, command, princ

相关帖子

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

使用道具 举报

qjcpj
发表于 2006-11-21 13:01:35 | 显示全部楼层
将w设为全局变量就可以了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

cdlh
 楼主| 发表于 2006-11-23 10:45:36 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 qjcpj 发布
[B]将w设为全局变量就可以了。 [/B]

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

使用道具 举报

zxq0220

已领礼包: 11310个

财富等级: 富甲天下
发表于 2006-11-23 13:48:13 | 显示全部楼层
删去(defun C:xk 后面括弧中的w就可以了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

cdlh
 楼主| 发表于 2006-11-23 19:41:19 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 zxq0220 发布
[B]删去(defun C:xk 后面括弧中的w就可以了。 [/B]

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

使用道具 举报

xyp1964
发表于 2006-11-23 22:57:54 | 显示全部楼层
试试签名栏下的“改线宽”程序
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xshrimp

已领礼包: 208个

财富等级: 日进斗金
发表于 2006-11-24 23:15:49 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
修改一下.
[php]
  ;;;  该程序可修改线,弧,圆及多义线的宽度
(defun C:xk (/ p l n e q  a m b  layer0 color0 linetype0 layer1 color1 linetype1 rad-out rad-in)
  (setq oldblp (getvar "blipmode")
        oldech (getvar "cmdecho")
        olderr *error*
        linetype1 (getvar "celtype")
        layer1 (getvar "clayer")
        color1 (getvar "cecolor")
  )
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (defun *error* (msg)
    (princ "\n")
    (princ msg)
    (setvar "blipmode" oldblp)
    (setvar "cmdecho" oldech)
    (setq *error* olderr)
    (princ)
  )  
  (prompt "\n请选择要改变宽度的线,弧,圆及多义线.")
  (setq p (ssget))
(if p
(progn
  (if (= w nil) (setq w 50))
(setq width (getreal (strcat "\n请输入宽度<" (rtos W) ">: ")))
  (if (= width nil) (setq width w)(setq w width ))
  (setq l 0 m 0 n (sslength p))
  (while (< l n)
    (setq q (ssname p l))
    (setq ent (entget q))
    (setq b (cdr (assoc 0 ent)))
    (if (member b '("LINE" "ARC"))
      (progn
        (command "PEDIT" q "y" "w" width "x")
        (setq m (+ 1 m))
      )
    )
    (if (= "LWPOLYLINE" b)
      (progn
        (command "PEDIT" q "w" width "x")
        (setq m (+ 1 m))
      )
    )
    (if (= "CIRCLE" b)
      (progn
        (if (assoc 6 ent) (setq linetype0 (cdr (assoc 6 ent))) (setq linetype0 "bylayer"))
        (setq layer0 (cdr (assoc 8 ent)))
        (if (assoc 62 ent) (setq color0 (cdr (assoc 62 ent))) (setq color0 "bylayer"))
        (setq center0 (cdr (assoc 10 ent)))
        (setq radius0 (cdr (assoc 40 ent)))
        (setq diameter0 (* 2 radius0))
        (entdel q)
        (command "color" color0)
        (command "layer" "s" layer0 "")
        (command "linetype" "s" linetype0 "")
        (if (> w diameter0)
          (progn
            (princ "\n\t 因线宽大于圆的直径，故将该圆填充")
            (princ)
            (setq rad-out (* 2 radius0)
                  rad-in 0
            )
          )
        )
        (if (<= w diameter0)
          (progn
            (setq rad-out (+ (* 2 radius0) width)
                  rad-in (- (* 2 radius0) width)
            )
          )
        )
        (command "donut" rad-in rad-out center0 "")
        (setq m (+ 1 m))
      )
    )
    (setq l (+ 1 l))
  )
  (if (= 0 m)
    (progn
     (princ "\n\t  没有任何线,弧,圆及多义线被选中")
      (princ)
    )
  )
  ))
  (setvar "blipmode" oldblp)
  (setvar "cmdecho" oldech)
  (setq *error* olderr)
  (command "color" color1)
  (command "layer" "s" layer1 "")
  (command "linetype" "s" linetype1 "")
  (princ)
)


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

使用道具 举报

qjcpj
发表于 2006-11-25 00:25:02 | 显示全部楼层
“记忆”功能最好使用注册表函数，模块使用完毕时将参数写入注册表，当下次运行程序时读入参数。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-29 19:28 , Processed in 0.179892 second(s), 44 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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