无惢 发表于 2013-4-14 18:47:48

改线宽lsp：要求一键到位

改线宽lsp，要求一步到位。比如我需要的是100宽的线。无论是直线，PL线，圆弧（可能的话，还有圆，
样条曲线，椭圆等（应该难实现））都能直接改成100.不需要再去选择和输入线宽等。

oldnewlearn 发表于 2013-4-14 18:47:49

(setq Lwidth 100)

oldnewlearn 发表于 2013-4-14 21:04:29

(defun C:PW ()
(setq oldosmode (getvar "osmode"))   ;获取当前捕捉设置，程序结束后，恢复此设置。
(setvar "cmdecho" 0)      ; 关闭命令响应
(if (= Lwidth nil) (setq Lwidth 0.0) )
(setq swidth (getreal (strcat "\n线宽:<" (rtos Lwidth 2 1) ">")))
(if (/= swidth nil)(setqLwidth swidth) )
(setq n "t")
(while (= n "t")
    (setq ob (entsel "\n选择直线、弧或园:"))
    (if (= ob nil) (setq n "f") )
    (if (/= ob nil)
      (progn
      (setq ent1 (entget (car ob)))
      (setq t1(cdr (assoc 0 ent1)))
      (if (or (= t1 "直线") (= t1 "LINE") )   (command "pedit" ob "y" "w" Lwidth ""))
      (if (or (= t1 "POLYLINE") (= t1 "多段线") (= t1 "LWPOLYLINE"))   (command "pedit" ob "w" Lwidth "") )
      (if (or (= t1 "ARC") (= t1 "圆弧"))(command "pedit" ob "y" "w" Lwidth ""))
      (if (= t1 "CIRCLE")
          (progn
            (setvar "osmode" 0)
            (setq center0 (cdr (assoc 10 ent1)))
            (setq radius0 (cdr (assoc 40 ent1)))
            (setq diameter0 (* 2 radius0))
            (entdel (car ob))
            (if (> Lwidth diameter0) (setq rad-out (* 2 radius0) rad-in 0) )
            (if (<= Lwidth diameter0) (setq rad-out (+ (* 2 radius0) Lwidth)rad-in (- (* 2 radius0) Lwidth) ))
            (command "donut" rad-in rad-out center0 "")
          );end progn
      );end if
      (setvar "osmode" oldosmode)
      );end progn
    );end if
   );end while
   (setvar "cmdecho" 1)      
   (princ)    ;静默退出
)

lingduwx 发表于 2013-4-14 21:23:37

顶一个，支持直线，PL线，圆弧，圆，
建议
1、要是能支持曲线及椭圆就更好了，
2、建议支持框选
谢谢！

print1985 发表于 2013-4-14 21:49:28

善用搜索 论坛早有此类lisp

无惢 发表于 2013-4-14 21:57:01

oldnewlearn 发表于 2013-4-14 21:04 static/image/common/back.gif
(defun C:PW ()
(setq oldosmode (getvar "osmode"))   ;获取当前捕捉设置，程序结束后，恢复此设置。 ...

不行，不直接。TSSD也有改线宽命令。要求：输入快捷键选择线条就是100，才叫一键到位。呵呵，麻烦改进下。最好能框选。

无惢 发表于 2013-4-14 22:54:39

oldnewlearn 发表于 2013-4-14 18:47 static/image/common/back.gif
(setq Lwidth 100)

太感谢你了，让小弟突然明白了很多。。。改成了不少程序 。。。呵呵

无惢 发表于 2013-4-14 22:55:20

oldnewlearn 发表于 2013-4-14 18:47 static/image/common/back.gif
(setq Lwidth 100)

很经典啊。。。这句。达到了我的目的

fhxu 发表于 2013-4-20 16:10:32

很好用，感谢分享！！

香田里浪人 发表于 2013-4-20 21:09:53

(defun C:CW (/ p l n nw chm en ow enm e1)
      (setq p (ssget))
      (if p (progn
      (setq l 0 n (sslength p) chm 0)
      (while (< l n)
          (setq enm (cdr (assoc 0 (setq en (entget (ssname p l))))))
          (if(or (= enm "LWPOLYLINE") (= enm "POLYLINE") (= enm "LINE") (= enm "ARC")(= enm "CIRCLE"))
             (progn
               (if (zerop chm) (progn
               (if (and (/= enm "LINE") (/= enm "ARC")) (setq ow (cdr (assoc 40 en)))
                   (setq ow 0))
                (princ "\n新线宽<")
                (princ (rtos (/ ow 1) 2 2))
                (setq nw (getreal "mm>:"))
                (if (null nw) (setq nw ow))
            ))
           (if (= enm "CIRCLE")
             (progn
             ;(setq angle1 (/ pi 2))
             (setq pt1 (polar (CDR(ASSOC 10 EN)) 0 (CDR(ASSOC 40 EN))))
             (setq pt2 (polar (CDR(ASSOC 10 EN)) pi (CDR(ASSOC 40 EN))))
             (command ".BREAK" pt1 pt2)
             (command "pedit" (ssname p l) "y" "w" nw "c" "")
             ))
           (if (or (= enm "LINE") (= enm "ARC"))
             (command "pedit" (ssname p l) "y" "w" nw "")
             
             (if (or(= enm "LWPOLYLINE") (= enm "POLYLINE"))
                   (command "pedit" (ssname p l) "w" nw "")
             )
             )
            (setqchm (1+ chm))
          ))
          (setq l (1+ l))
      )
      ))
      (princ "改了") (princ chm) (princ "条线.")
      (PRINC)
)
页: [1] 2
查看完整版本: 改线宽lsp：要求一键到位