改线宽lsp：要求一键到位

无惢

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

oldnewlearn

(setq Lwidth 100)

oldnewlearn

(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)(setq  Lwidth 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

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

print1985

善用搜索 论坛早有此类lisp

无惢

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

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

无惢

oldnewlearn 发表于 2013-4-14 18:47
(setq Lwidth 100)

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

无惢

oldnewlearn 发表于 2013-4-14 18:47
(setq Lwidth 100)

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

fhxu

很好用，感谢分享！！

香田里浪人

(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 "")
               )  
             )
              (setq  chm (1+ chm))
          ))
          (setq l (1+ l))
        )
      ))
      (princ "改了") (princ chm) (princ "条线.")
      (PRINC)
)