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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › .....................................
12下一页
返回列表 发新帖
查看: 1165|回复: 20

[求助] .....................................

[复制链接]
贱人
发表于 2005-5-4 22:26:16 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
本帖最后由 贱人 于 2025-4-18 05:54 编辑

.....................................
assoc, setq, ei

相关帖子

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

使用道具 举报

狂刀
发表于 2005-5-4 23:12:02 | 显示全部楼层
真是大开眼界，一个小程序能写这么长。。。。佩服
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

贱人
 楼主| 发表于 2005-5-4 23:18:26 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 贱人 于 2025-4-18 05:55 编辑

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

使用道具 举报

xyp1964
发表于 2005-5-5 13:45:12 | 显示全部楼层
支持用户输入或匹配：
[php]
(load "xyp_lib");加载通用函数
;|
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在每个程序内增加(load"xyp_lib")
2.在acad.lsp中增加(load"xyp_lib")
3.在command下，输入(load"xyp_lib")
4.在菜单.mnl中增加(load"xyp_lib")
通用函数下载地址：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
|;


;;;改线宽
(defun C:test126 ()
  (CMDla0)
  (setq txt5 (ukword 1 "1 2" "\n请选择方式：1-用户输入/2-匹配" txt5))
  (if (= txt5 "1")
    (while (not (setq no1 (ureal 1 "" "\n线宽" no1))))
  )
  (if (= txt5 "2")
    (setq no1 (dxf 41 (entget (car (entsel "\n选宽线 : ")))))
  )
  (princ "\n\t请选择被改线 : ")
  (while (not (setq ss (ssget))))
  (setq        i  0
        sn (sslength ss)
        n  0
  )
  (prompt "\n稍候 ")
  (vl-cmdf ".undo" "BE")
  (while (< i sn)
    (setq s1        (ssname ss i)
          etype        (dxf 0 (entget s1))
    )
    (if        (or
          (= etype "POLYLINE")
          (= etype "LWPOLYLINE")
        )
      (progn
        (command "pedit" s1 "w" no1 "")
        (princ ".")
        (princ)
        (setq n (1+ n))
      )
    )
    (if        (or
          (= etype "LINE")
          (= etype "ARC")
        )
      (progn
        (command "pedit" s1 "Y" "w" no1 "")
        (princ ".")
        (princ)
        (setq n (1+ n))
      )
    )
    (setq i (1+ i))
  )
  (vl-cmdf ".undo" "E")
  (princ "完毕。")
  (princ "\n共有 ")
  (princ n)
  (princ " 条线被修改线宽。")
  (CMDla1)
  (pxyp "GXK  (改线宽)")
)[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

贱人
 楼主| 发表于 2005-5-5 19:30:52 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 贱人 于 2025-4-18 05:55 编辑

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

使用道具 举报

狂刀
发表于 2005-5-5 20:02:41 | 显示全部楼层
(defun c:tt(/ ss w)
  (princ "\n刷线宽----by 狂刀.  \n选参照多义线:")
  (if (and(setq ss (ssget ":s" '((0 . "*POLYLINE"))))
          (setq w (cdr(assoc 43 (entget(ssname ss 0)))))
       )
      (command ".pedit" "m" (ssget '((0 . "*POLYLINE"))) "" "w" w "")
  )(princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

贱人
 楼主| 发表于 2005-5-5 21:27:34 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 贱人 于 2025-4-18 05:56 编辑

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

使用道具 举报

xyp1964
发表于 2005-5-6 09:40:14 | 显示全部楼层
最初由 贱人 发布
[B]又要加载xyp_lib这个东西，能不能把xyp_lib里用到的提取出来，我不想加载xyp_lib [/B]

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

使用道具 举报

god
发表于 2005-5-6 09:52:12 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
一个cad强人的代码


  3. ;;PW.LSP AutoCAD的线宽转换程序
  4. ;;可以处理line、Pline、arc、circle、Mline等实体，各版本通用。
  5. ;;编制：谢永忠 [email]xiewer@iname.com[/email] [url]http://xyzcad.yeah.net[/url]

  7. ;;=====================================  线宽设置 =============================
  8. (setq pw:olderr *error*)
  9. (defun pw_err (s)
  10.         (if (/= s "Function cancelled")
  11. ; If an error (such as CTRL-C) occurs
  12.                 (princ (strcat "Error: " s)) ; while this command is active...
  13.         )
  14.         (COMMAND "UNDO" "BACK")
  15.         (prompt "\n [ 设置恢复! ]")
  16.         (setq *error* pw:olderr)
  17.         (princ)
  18. )


  21. (defun C:PW        (/ i ss_mline ent str line_no1 pw:oldosmode)
  22.         (setvar "cmdecho" 0)
  23.         (COMMAND "UNDO" "MARK")
  24.         (prompt "[Undo marked]\n")
  25.         (setq *error* pw_err)
  26.         (setq width (getreal "转换后的线宽: "))
  27.         ;;转换图形中的所有“MLINE”线条为“LINE”线条
  28.         (setq ss_mline (ssget "X" (list (cons 0 "MLINE"))))
  29.         (if ss_mline
  30.                 (command "_.explode" ss_mline)
  31.         )
  32.         (setq plines (ssget (list '(0 . "POLYLINE,LWPOLYLINE,ARC,LINE,CIRCLE"))))
  33.         (setq line_no1 (sslength plines))
  34.         (princ (strcat        "转换选择集中线条为宽度 "
  35.                                                 (rtos width)
  36.                                                 ",线数 "
  37.                                                 (itoa line_no1)
  38.                                                 "..."
  39.                          )
  40.         )
  41.         (if plines
  42.                 (progn (setq i 0)
  43.                                  (setq pw:oldOsmode (getvar "osmode"))
  44.                                  (setvar "osmode" 0)
  45.                                  (while (setq ent (ssname plines i))
  46.                                          (PWprocess ent width)
  47.                                          (setq i (1+ i))
  48.                                          ;;(princ (strcat "\r " (rtos i) " of " (itoa line_no1)))
  49.                                  )
  50.                                  (setvar "osmode" pw:oldOsmode)
  51.                 )
  52.         )
  53.         (setvar "cmdecho" 1)
  54.         (setq *error* pw:olderr)
  55.         (princ)
  56. )
  57. ;;end defun

  59. (defun PWProcess (entname width)
  60.         (setvar "blipmode" 0)
  61.         (setvar "plinewid" width)
  62.         ;;(command "layer" "LOCK" "hatch" "")
  63.         (setq edent (entget entname))
  64.         (cond        ;;"PLINE"
  65.                         ((or (= "LWPOLYLINE" (cdr (assoc 0 edent)))
  66.                                   (= "POLYLINE" (cdr (assoc 0 edent)))
  67.                          )
  68.                          (command "pedit" entname "W" width "")
  69.                         )
  70.                         ;;"LINE" "ARC"
  71.                         ((or (= "ARC" (cdr (assoc 0 edent)))
  72.                                   (= "LINE" (cdr (assoc 0 edent)))
  73.                          )
  74.                          (command "pedit" entname "" "W" width "")
  75.                         )
  76.                         ;;"CIRCLE"
  77.                         ((= "CIRCLE" (cdr (assoc 0 edent)))
  78.                          (setq cp (cdr (assoc 10 edent))) ;center point
  79.                          (setq r (cdr (assoc 40 edent))) ;radius
  80.                          (entdel entname) ;delete old "CIRCLE"
  81.                          (setq edent_layer (cdr (assoc 8 edent)))
  82.                          (command "layer" "s" edent_layer "")
  83.                          (command "_.donut"
  84.                                                  (* 2.0 (- r (/ width 2)))
  85.                                                  (* 2.0 (+ r (/ width 2)))
  86.                                                  cp
  87.                                                  ""
  88.                          )
  89.                         )
  90.         )
  91.         (command "layer" "UNLOCK" "hatch" "")
  92.         (command "setvar" "blipmode" 1)
  93. ;(command "redraw")
  94. ) ; end PWProcess


  97. (princ
  98.         "线宽转换程序载入，用PW执行! CAD园地--http://xyzcad.yeah.net,98.5"
  99. )
  100. (princ)

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

使用道具 举报

贱人
 楼主| 发表于 2005-5-6 20:27:31 | 显示全部楼层
本帖最后由 贱人 于 2025-4-18 05:56 编辑

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

使用道具 举报

zhouri
发表于 2005-5-6 21:40:12 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 xyp1964 发布
[B]支持用户输入或匹配：
[php]
(load "xyp_lib");加载通用函数
;|
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在每个程序内增加(load"xy... [/B]



请问一下，xyp。你是用的什么编辑软件，用的是cad自带的vlisp编辑工具，还是其他，我感觉你的程序很工整。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-5-6 21:50:45 | 显示全部楼层
最初由 zhouri 发布
[B][QUOTE]最初由 xyp1964 发布
[B]支持用户输入或匹配：
[php]
(load "xyp_lib");加载通用函数
;|
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所... [/B]

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

使用道具 举报

狂刀
发表于 2005-5-8 21:19:50 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 贱人 发布
[B]楼上的，直线和圆弧好象不能刷 [/B]


自己调一下嘛,别那么懒.

模拟刷子,刷多义线宽度
支持*polyline,arc,line
支持循环多次选择

[php]
(defun c:plmw (/ el w ss)
  (princ "\n刷线宽----by 狂刀. ")
  (if (and (setq el (entsel "\n选参照多义线宽度:"))
           (setq w (cdr (assoc 43 (entget (car el)))))
      )
    (while (setq ss (ssget '((0 . "*POLYLINE,ARC,LINE"))))
      (command ".pedit" "m" ss  "")
      (if (NOT (wcmatch        (cdr (assoc 0 (entget(ssname ss 0))))
                        "*POLYLINE"
               )
          )
        (COMMAND "")
      )
      (command "w" w "")
    )
  )
  (princ)
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-28 05:34 , Processed in 0.330565 second(s), 60 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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