可以自动改变直线圆等的线形比例 ,但不能改变矩形及多段线的请修改一下

jiajun_16888 · 发表于 2010-4-30 23:40:00

大家好我这有一个非常好的LISP程序可以自动改变直线，圆等的线形比例但不能改变矩形及多段线的的哪位大大修改一下

(defun c:df () ;自動變換成適當比例的虛線
(ltchange "dashed" 3 "bylayer")
(princ)
)

(defun ltchange (type1 scale color / oce   lin   n    nam tab
   pt1   pt2   x1    x2 y1    y2    len   leg sca
   otyp ocol osca col typ   lts   rad
  )   ;自動變換成適當比例的中心線
(setq oce (getvar "cmdecho")
lts (getvar "ltscale")
) ;_ end of setq
(setvar "cmdecho" 0)
(setq n 0)
(print
    (strcat "Select object change to " type1 ":")
) ;_ end of print
(setq lin (ssget '((-4 . "<OR")
       (0 . "LINE")
       (0 . "CIRCLE")
       (0 . "ELLIPSE")
       (0 . "ARC")
       (0 . "polyline")
       (-4 . "OR>")
      )
     ) ;_ end of ssget
)     ;end setq
(if (not lin)
    (progn

      (alert "\nNo selection!")
      (exit)
    ) ;_ end of progn
)     ;end if
(repeat (sslength lin)
    (setq nam (ssname lin n))
    (setq tab (entget nam))
;;;;;;;;;;circle
    (if (= (cdr (assoc 0 tab)) "CIRCLE")
      (progn
(setq rad (cdr (assoc 40 tab)))
(setq len (* 2 (* 3.14 rad)))
      )     ;如是圓實體取周長為"len"
;;;;;;;;;;ARC
      (if (= (cdr (assoc 0 tab)) "ARC")
(progn
   (setq rad (cdr (assoc 40 tab)))
   (setq len (* 3.14 rad))
)    ;end progn;如是圓弧取其圓周長半

;;;;;;;;;;ellipse
    (if (= (cdr (assoc 0 tab)) "ellipse")
      (progn
(setq rad (cdr (assoc 40 tab)))
(setq len (* 2 (* 3.14 rad)))
      )
;;;;;;;;;LINE
(progn
   (setq pt1 (cdr (assoc 10 tab))
  pt2 (cdr (assoc 11 tab))
  len (distance pt1 pt2)
   )    ;end setq
)    ;end progn
      )     ;end if
    )
   );end if

    (cond ((and (> len 0) (<= len 2))
    (setq leg 2)
   )
   ((and (> len 2) (<= len 5))
    (setq leg 6)
   )
   ((and (> len 5) (<= len 30))
    (setq leg 20)
   )
   ((and (> len 30) (<= len 50))
    (setq leg 40)
   )
   ((and (> len 50) (<= len 100))
    (setq leg 75)
   )
   ((> len 100)
    (setq leg 100)
   )
    )     ;end cond
    (setq sca (/ leg scale lts 2))

    (command "-linetype" "l" type1 "acad.lin" "" "")
    (command "change" nam "" "p" "c" color "lt" type1 "s" SCA "") ;_ end of command
;_ end of command
;_ end of command
    (setq n (+ n 1))
)     ;end repeat
(setvar "cmdecho" oce)
(princ)
) ;_ end of defun

ZZXXQQ · 发表于 2010-5-1 10:14:00

本帖最后由作者于 2010-5-1 20:42:48 编辑

(defun c:df () ;自動變換成適當比例的虛線
(ltchange "dashed" 3 "bylayer")
(princ)
)
(defun ltchange (type1 scale color / oce lts lin n nam len leg sca) ;自動變換成適當比例的中心線
(setq oce (getvar "cmdecho")
lts (getvar "ltscale"))
(setvar "cmdecho" 0)
(setq n 0)
(princ (strcat "\nSelect object change to " type1 ":"))
(if (setq lin (ssget '((0 . "ARC,CIRCLE,*LINE,ELLIPSE")))) (progn
(repeat (sslength lin)
(setq nam (ssname lin n))
(command "lengthen" nam "")
(setq LEN (getvar "perimeter"))
(cond
((> 2 len 0) (setq leg 2))
((> 5 len 2) (setq leg 6))
((> 30 len 5) (setq leg 20))
((> 50 len 30) (setq leg 40))
((> 100 len 50) (setq leg 75))
((> len 100) (setq leg 100))
);end cond
(setq sca (/ leg scale lts 2))
(command "-linetype" "l" type1 "acad.lin" "" "")
(command "change" nam "" "p" "c" color "lt" type1 "s" SCA "") ;_ end of command
(setq n (1+ n))
);end repeat
));end if
(setvar "cmdecho" oce)
(princ)
);_ end of defun

jiajun_16888 · 发表于 2010-5-1 10:26:00

谢啦但我试了下说是错误参数太多不能用啊

ZZXXQQ · 发表于 2010-5-1 20:43:00

二楼已改，再试试。

jiajun_16888 · 发表于 2010-5-2 00:14:00

还是不行啊，df \nSelect object change to dashed:; 错误: 参数太多
是不是版本不同啊我是CAD2004的把矩形及多段线打散也可以的

帮忙再改下

ZZXXQQ · 发表于 2010-5-2 21:29:00

我是在2004下调试通过的，没问题呀！

jiajun_16888 · 发表于 2010-5-2 22:51:00

(defun c:df () ;自動變換成適當比例的虛線
  (ltchange "dashed" 3 "bylayer")
  (princ)
)
(defun ltchange (type1 scale color / oce lts lin n nam len leg sca) ;自動變換成適當比例的中心線
(setq oce (getvar "cmdecho")
   lts (getvar "ltscale"))
(setvar "cmdecho" 0)
(setq n 0)
(princ (strcat "\\nSelect object change to " type1 ":"))
(if (setq lin (ssget \'((0 . "ARC,CIRCLE,*LINE,ELLIPSE")))) (progn
  (repeat (sslength lin)
(setq nam (ssname lin n))
(command "lengthen" nam "")
(setq LEN (getvar "perimeter"))
(cond
((> 2 len 0) (setq leg 2))
((> 5 len 2) (setq leg 6))
((> 30 len 5) (setq leg 20))
((> 50 len 30) (setq leg 40))
((> 100 len 50) (setq leg 75))
((> len 100) (setq leg 100))
);end cond
(setq sca (/ leg scale lts 2))
(command "-linetype" "l" type1 "acad.lin" "" "")
(command "change" nam "" "p" "c" color "lt" type1 "s" SCA "") ;_ end of command
(setq n (1+ n))
  );end repeat
));end if
(setvar "cmdecho" oce)
(princ)
);_ end of defun

是这样吧  我怎么试就是不行呢

[此贴子已经被作者于2010-5-1 20:42:48编辑过]

jiajun_16888 · 发表于 2010-5-3 08:48:00

谢啦我又试了下可以了 ssget \'((0 . "ARC,CIRCLE,*LINE,ELLIPSE")) 把里面的\去掉就可以了

dcc1973 · 发表于 2010-5-7 11:41:00

还是不行啊，df \nSelect object change to dashed:; 错误: 参数太多
是不是版本不同啊我是CAD2004的把矩形及多段线打散也可以的

帮忙再改下

ZZXXQQ · 发表于 2010-5-7 21:12:00

回9楼：看8楼的改动。

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

可以自动改变直线圆等的线形比例 ,但不能改变矩形及多段线的 请修改一下

可以自动改变直线圆等的线形比例 ,但不能改变矩形及多段线的请修改一下