[LISP程序]：单侧或双侧加粗直线或多义线程序

gysjy · 发表于 2005-11-27 11:38:33

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

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

×

这个小程序并不加粗直线或多义线本身，而是在原有线的一侧添加一根你指定宽度的线。
天正绘制剖面的程序中，绘制楼板加粗步骤很复杂，且绘成的楼板是个块（好象还炸不掉），我干脆就用这个程序，加粗楼板很方便，也便于拉伸、剪断。此外，立面外包线、详图的加粗也很方便。
该加粗线绘制在jiacu层，你可以在不需要的时候（例如在绘制结构图时不需要加粗线），用本人的“筛选删除”删掉加粗线，原有的细线则仍旧保留。

命令名：jiacu
使用步骤：1. 输入您要的线宽；
      2. 点取待加粗的线；
      3. 用鼠标点取要加粗在哪一侧（回车默认右上侧）；
      4. 如要继续加粗其他的线，则继续点取第二根线，输入w则改变线宽；回车则结束程序。

单、双侧加粗请见下一页。

登录/注册后可看大图

whiteon · 发表于 2006-4-25 20:19:41

对我来说这是一个很方便的程序！

xjlong547 · 发表于 2006-4-28 21:25:34

樓主能不能向兩側同時加呀?

gysjy · 发表于 2006-4-29 12:29:15

可以。

)

[FONT=courier new]
(defun c:nn(/ p1 ss sn en )
(setvar "osmode" 512)
(setvar "cmdecho" 0)
(graphscr)
(if (= xkuan nil) (setq xkuan 45))
(princ "\n线宽<") (princ xkuan)
(setq x (getint ">:") n (if x x xkuan))
(setq p1 (getpoint "\n选择要加粗的线:"))
(while p1
(setq ss (ssget p1) m 0 )
(setq sn (ssname ss m) en (entget sn))
(if (= "LINE" (cdr (assoc 0 en)))
(command "pedit" p1 "y" "w" n "")
(command "pedit" p1 "w" n "")
)
(initget "W")
(setq p1 (getpoint (strcat "\n(线宽为" (itoa n) ") 改线宽W/选择要加粗的线:")))
(if (eq "W" p1)
(progn
(princ "\n线宽<") (princ n)
(setq x (getint ">:") n (if x x n))
(setq p1 (getpoint "\n选择要加粗的线:"))
)
)
)
(princ)
[/FONT]

sunway88 · 发表于 2007-4-17 22:07:11

这个工具非常实用，尤其是在处理大批量的线宽时，显得非常方便、快捷。但有个缺点，也不是缺点，只要楼主稍作修改就能化解这个瑕疵-------输入的命令太长，不够快捷。

高山仰止
景行行止
未必能至
心向往之

gysjy · 发表于 2007-5-1 10:02:00

打开 jiacu.lsp ，将文本中的c:jiacu改为c:j,存文件，以后执行j即可。

gysjy · 发表于 2007-5-1 11:05:39

打开 jiacu.lsp ，将文本中的c:jiacu改为c:j,存文件，以后执行j即可。

szdn · 发表于 2007-6-11 17:21:59

正好我需要。谢谢分享！

diskcopy · 发表于 2007-7-11 09:26:27

不错的程序，希望能多向楼主学习

zml84 · 发表于 2007-7-14 10:57:12

4楼代码，简化版：

(defun C:NN (/ P1 SS LX)
(if (= XK NIL)
(setq XK 45)
)
(while (progn
(princ "\n>>>当前设置:线宽=")
(princ XK)
(initget "W")
(setq PT1 (getpoint "\n选择要修改的线，或 [改变线宽(W)]:")
)
)
(if (= PT1 "W")
(progn
(princ "\n线宽<")
(princ XK)
(if (setq TMP (getreal ">:"))
(setq XK (abs TMP))
)
)
(if (setq SS (ssget PT1))
(progn
(setq LX (cdr (assoc 0
(entget (ssname SS 0))
)
)
)
(cond
((or (= LX "LINE") (= LX "ARC"))
(command "_.pedit" SS "y" "w" XK "")
)
((= LX "LWPOLYLINE")
(command "_.pedit" SS "w" XK "")
)
(t
(princ
"\n>>>对象类型应为：LINE / ARC / LWPOLYLINE"
)
)
)
)
(princ "\n>>>未选取到对象。")
)
)
)
(princ)
)

(defun C:NN (/ P1 SS LX) 
    (if        (= XK NIL) 
        (setq XK 45) 
    ) 
    (while (progn 
               (princ "\n>>>当前设置:线宽=") 
               (princ XK) 
               (initget "W") 
               (setq PT1 (getpoint "\n选择要修改的线，或 [改变线宽(W)]:") 
               ) 
           ) 
        (if (= PT1 "W") 
            (progn 
                (princ "\n线宽<") 
                (princ XK) 
                (if (setq TMP (getreal ">:")) 
                    (setq XK (abs TMP)) 
                ) 
            ) 
            (if        (setq SS (ssget PT1)) 
                (progn 
                    (setq LX (cdr (assoc 0 
                                         (entget (ssname SS 0)) 
                                  ) 
                             ) 
                    ) 
                    (cond 
                        ((or (= LX "LINE") (= LX "ARC")) 
                         (command "_.pedit" SS "y" "w" XK "") 
                        ) 
                        ((= LX "LWPOLYLINE") 
                         (command "_.pedit" SS "w" XK "") 
                        ) 
                        (t 
                         (princ 
                             "\n>>>对象类型应为：LINE / ARC / LWPOLYLINE" 
                         ) 
                        ) 
                    ) 
                ) 
                (princ "\n>>>未选取到对象。") 
            ) 
        ) 
    ) 
    (princ) 
)

szx025 · 发表于 2007-7-14 11:23:27

该程序的精华是单侧加粗,而不是双侧加粗,如增加一个判断,让单双侧能根据需要进行,程序就完满了,

gysjy · 发表于 2007-7-15 09:46:58

最初由 szx025 发布
[B]该程序的精华是单侧加粗,而不是双侧加粗,如增加一个判断,让单双侧能根据需要进行,程序就完满了, [/B]

以下为修改过的程序，可以进行单、双侧的加宽。这里参照了10楼的构思，在此一并感谢！

登录/注册后可看大图

[FONT=courier new]
(princ "\ngysjy0欢迎您使用加粗线程序！该程序命令名是jiacu。")
(defun c:jiacu(/ op oc p1 ss sn en n2 p2)
;(setq oer *error* *error* myerr)
(setq op (getvar "plinewid") oc (getvar "clayer"))
(setvar "cmdecho" 0)
(command "undo" "g")
(graphscr)
(if (= kuan nil) (setq kuan 45))
(princ "\n线宽<") (princ kuan)
(setq x (getint ">:") kuan (if x x kuan))
(while
(progn
(initget "W")
(setq sn (entsel (strcat "\n(线宽为" (itoa kuan) ") 改线宽W/选择要加粗的
线:")))
)
(if (eq "W" sn)
(progn
(princ "\n线宽<") (princ kuan)
(setq x (getint ">:") kuan (if x x kuan))
(setq sn (entsel "\n选择要加粗的线:"))
)
)
(setq n2 (* kuan 0.5) sn (car sn))
(setvar "osmode" 0)
(setq p2 (getpoint "\n哪一侧(请在加粗的一侧点取一点)<双侧加粗>:"))
(if p2 (progn
(command "offset" n2 sn p2 "")
(setq sn (entlast))
))
(if (= (tblsearch "LAYER" "jiacu") nil) (command "layer" "n" "jiacu" ""))
(setq nam (cdr (assoc 0 (entget sn))))
(cond
((or (= "LINE" nam) (= "ARC" nam))
(command "_.pedit" sn "y" "w" kuan "")
)
((= nam "LWPOLYLINE")
(command "_.pedit" sn "w" kuan "")
)
(t
(princ "\n>>>对象类型应为：LINE / ARC / LWPOLYLINE")
)
)
(command "chprop" "l" "" "la" "jiacu" "")
)
(setvar "clayer" oc)
(setvar "plinewid" op)
(command "undo" "e")
(setq *error* oer)(princ)
)
[/FONT]

[FONT=courier new] 
(princ "\ngysjy0欢迎您使用加粗线程序！该程序命令名是jiacu。")   
(defun c:jiacu(/ op oc p1 ss sn en n2 p2) 
  ;(setq oer *error* *error* myerr) 
  (setq op (getvar "plinewid") oc (getvar "clayer"))    
  (setvar "cmdecho" 0)   
  (command "undo" "g")       
  (graphscr) 
  (if (= kuan nil) (setq kuan 45)) 
  (princ "\n线宽<") (princ kuan) 
  (setq x (getint ">:") kuan (if x x kuan)) 
  (while 
    (progn 
       (initget "W") 
       (setq sn (entsel (strcat "\n(线宽为" (itoa kuan) ") 改线宽W/选择要加粗的 
 
线:"))) 
    )    
    (if (eq "W" sn) 
      (progn 
        (princ "\n线宽<") (princ kuan) 
        (setq x (getint ">:") kuan (if x x kuan)) 
        (setq sn (entsel "\n选择要加粗的线:")) 
      ) 
    )    
    (setq n2 (* kuan 0.5) sn (car sn)) 
    (setvar "osmode" 0) 
    (setq p2 (getpoint "\n哪一侧(请在加粗的一侧点取一点)<双侧加粗>:")) 
    (if p2 (progn 
        (command "offset" n2 sn p2 "") 
        (setq sn (entlast)) 
    )) 
    (if (= (tblsearch "LAYER" "jiacu") nil) (command "layer" "n" "jiacu" "")) 
    (setq nam (cdr (assoc 0 (entget sn)))) 
    (cond 
      ((or (= "LINE" nam) (= "ARC" nam)) 
        (command "_.pedit" sn "y" "w" kuan "") 
        ) 
      ((= nam "LWPOLYLINE") 
         (command "_.pedit" sn "w" kuan "") 
      ) 
      (t 
         (princ "\n>>>对象类型应为：LINE / ARC / LWPOLYLINE") 
      ) 
    ) 
    (command "chprop" "l" "" "la" "jiacu" "") 
  ) 
  (setvar "clayer" oc)       
  (setvar "plinewid" op)   
  (command "undo" "e") 
  (setq *error* oer)(princ) 
) 
  [/FONT]

zml84 · 发表于 2007-7-15 12:53:12

楼主就是强。
建议将主程序与函数分离出来，这样可以为批量修改打基础。

gysjy · 发表于 2007-7-15 21:15:55

最初由 zml84 发布
[B]
建议将主程序与函数分离出来，这样可以为批量修改打基础。 [/B]

批量修改指的是什么，就这一程序而言，主程序与函数可以怎样分呢？

gysjy · 发表于 2007-7-15 21:51:13

最初由 zml84 发布
[B]
建议将主程序与函数分离出来，这样可以为批量修改打基础。 [/B]

批量修改指的是什么，就这一程序而言，主程序与函数可以怎样分呢？

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：单侧或双侧加粗直线或多义线程序

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

相关帖子