完善一下程序（加粗直线）

szx025 · 发表于 2013-5-14 11:10:27

;;;加粗线程序
；(princ "\欢迎您使用加粗线程序！该程序命令名是jl。")
(defun c:jll(/ op oc p1 ss sn en n2 p2 kuan)
;(setq oer *error* *error* myerr)
(setq op (getvar "plinewid") oc (getvar "clayer"))
(setvar "cmdecho" 0)
(command "undo" "g")
(graphscr)
(if (= kuan nil) (setq kuan 60))
(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" "jl") nil) (command "layer" "n" "jl" ""))
(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" "jl" "")
)
(setvar "clayer" oc)
(setvar "plinewid" op)
(command "undo" "e")
(setq *error* oer)(princ)
)

;;;加粗线程序 
；(princ "\欢迎您使用加粗线程序！该程序命令名是jl。")   
(defun c:jll(/ op oc p1 ss sn en n2 p2 kuan) 
  ;(setq oer *error* *error* myerr) 
  (setq op (getvar "plinewid") oc (getvar "clayer"))    
  (setvar "cmdecho" 0)   
  (command "undo" "g")       
  (graphscr) 
  (if (= kuan nil) (setq kuan 60)) 
  (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" "jl") nil) (command "layer" "n" "jl" "")) 
    (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" "jl" "") 
  ) 
  (setvar "clayer" oc)       
  (setvar "plinewid" op)   
  (command "undo" "e") 
  (setq *error* oer)(princ) 
)

程序执行到“哪一侧(请在加粗的一侧点取一点)<双侧加粗>”这里时，“出现错误: 函数被取消”这时程序需要重新设置线宽才能完成加粗的任务。请高手完善一下

香田里浪人 · 发表于 2013-5-14 11:49:24

修改线宽程序如下，供参考。

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

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

szx025 · 发表于 2013-5-14 14:57:45

上面的程序不能选择加粗直线的方向，另外好像加粗的宽度不能小于10

香田里浪人 · 发表于 2013-5-15 10:53:22

szx025 发表于 2013-5-14 14:57
上面的程序不能选择加粗直线的方向，另外好像加粗的宽度不能小于10

是不能加粗直线，只能加粗多义线，加粗宽度不受限制。

香田里浪人 · 发表于 2013-5-15 11:03:48

其实既能加粗直线，也能加粗其他线，宽度不受限制。

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

[已解答] 完善一下程序（加粗直线）

相关帖子