明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2400|回复: 16

[源码] 连续加粗(绝对原创)

[复制链接]
发表于 2013-10-11 07:31 | 显示全部楼层 |阅读模式
;;;1.设置了缺省值;
;;; 2.也可以刷宽度;
;;; 3.加粗线段既可点选,也可框选;
;;; 4.可以连续加粗;
;;; 5.按右键、空格键或enter键,即可退出。
(defun gg () ;将圆转化为多义线
  (setq len (sslength ss) i 0)
  (repeat len
    (setq ent (entget (setq en (ssname ss i))))
    (if (= (cdr (assoc 0 ent)) "CIRCLE") (progn
      (setq c (cdr (assoc 10 ent)) r (cdr (assoc 40 ent)))
      (setq p1 (polar c 0 r) p2 (polar c pi r))
      (entdel en)
      (entmake (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(90 . 3)(cons 10 p1)(cons 42 1.0)
        (cons 10 p2)(cons 42 1.0)(cons 10 p1)))
      (ssadd (entlast) ss)))
      (setq i (+ i 1))))
(defun c:cc (/ *error*) ;主程序开始
  (defun *error* (msg) ;将描述错误的字符串存入变量msg
    (setvar "osmode" os)
    (princ "错误: ")(princ msg)) ;打印错误信息
  (or kd (setq kd 0)) ;初次打开时,kd为nil,否则,均为前一次的输入。
  (initget 4 "C")
  (princ "\n指定宽度<") (princ kd) (princ ">/[刷宽度(C)]:") ;下一步getint函数的提示语,提示语中含有变量kd。
  (setq kd1 (getint))
  (if (= kd1 "C") (progn
    (setq ent (entget (car (entsel "\n选择参考对象:"))))
    (setq kd1 (cdr (assoc 43 ent)))
    (princ "\n参考宽度:") (princ (fix kd1)) (princ "   <<<"))
    (princ "\n"))
  (if kd1 (setq kd (fix kd1)))
  (princ "选择对象(线、弧、圆或多段线):") ;加粗后对象类型均为"LWPOLYLINE"
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq pd t)
  (while pd
    (while (not (member (car (setq gr (grread t 4 2))) '(2 3 11))))
    ;鼠标移动时重复,键盘输入、左键点击或右键点击后退出循环。
    (if (= (car gr) 3)
     (progn
       (setq pt (cadr gr))
       (if (not (setq ss (ssget pt))) (progn
         (setq pt1 (getcorner pt))
         (if (< (car pt1) (car pt)) (setq ss (ssget "c" pt pt1)))
         (if (> (car pt1) (car pt)) (setq ss (ssget "w" pt pt1)))))
         ;从右到左为框选,从左到右为窗选。
        (if ss (progn
          (gg) ;将圆转化为多义线
          (command "pedit" "m" ss "" "w" kd ""))))
     (setq pd nil)))
  (setvar "osmode" os)
  (princ))

发表于 2013-10-11 08:23 | 显示全部楼层
支持一下楼主,虽然用不到,源码就要顶一下。回帖一直要输验证码,烦
发表于 2013-10-11 08:43 | 显示全部楼层
楼主辛苦!
 楼主| 发表于 2013-10-11 08:46 | 显示全部楼层
emk 发表于 2013-10-11 08:23
支持一下楼主,虽然用不到,源码就要顶一下。回帖一直要输验证码,烦

对于autolisp刚刚入门的新手来说,学习方面的价值更大一些,程序中用到了一些比较常用的技巧,可以在其他autolisp程序套用。
发表于 2013-10-11 09:44 | 显示全部楼层
顶原码继续关注…………
发表于 2013-10-11 10:30 | 显示全部楼层
顶,还是不错哈,谢谢分享
发表于 2013-10-11 11:44 | 显示全部楼层
958620832 发表于 2013-10-11 08:46
对于autolisp刚刚入门的新手来说,学习方面的价值更大一些,程序中用到了一些比较常用的技巧,可以在其他 ...

是啊,确实如此,理解下程序结构和函数用法是很不错的,
(or kd (setq kd 0)) 这个写得不错,我还没这样用过,kd存在直接跳过,否则设为0
grread函数我一直没用过
(if (< (car pt1) (car pt)) (setq ss (ssget "c" pt pt1)))
(if (> (car pt1) (car pt)) (setq ss (ssget "w" pt pt1)))
可以改写为:(if (< (car pt1)(car pt))(setq ss (ssget "c" pt pt1))(setq ss (ssget "w" pt pt1)))
发表于 2013-10-11 11:47 | 显示全部楼层
是不是考虑排除(= (car pt1) (car pt)) )才这样写的?
发表于 2013-10-11 12:14 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
发表于 2013-10-11 13:07 | 显示全部楼层
多谢分享了,下来试用一下。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-6-16 03:41 , Processed in 0.166518 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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