可以自动改变直线，圆等的线形比例

jiajun_16888 · 发表于 2010-4-30 23:45: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

wide · 发表于 2018-11-19 11:24:52

不错的代码。

xyz2009xyz · 发表于 2010-7-26 08:24:00

怎样自动改变直线，圆等的线形比例？比如说我把图比例放大它也能自动调整线性比例？

Gu_xl · 发表于 2010-7-26 11:29:00

(defun c:tt (/ scale ss n k obj)
(setq scale (getreal "\n输入线型转换比例"))
(if (not scale) (exit))
(princ "\n选择要转换线型比例的实体：")
(setq ss (ssget))
(if ss
(progn
(setq n (sslength ss)
k 0)
(repeat n
(setq obj (vlax-ename->vla-object (ssname ss k)))
(setq newscale (* scale (vla-get-LinetypeScale obj)))
(vla-put-linetype obj "dashed")
(vla-put-LinetypeScale obj newscale)
(setq k (1+ k))
)
)
)
)

jfxia · 发表于 2011-1-5 23:26:39

Gu_xl 的程序如能自动根据实体的长度来判断比例就好了

xiaxiang · 发表于 2011-1-6 15:51:12

xyz2009xyz 发表于 2010-7-26 08:24
怎样自动改变直线，圆等的线形比例？比如说我把图比例放大它也能自动调整线性比例？

这个好像不好实现

zhouwanweihf · 发表于 2011-12-18 11:01:00

请帮忙顶起

功夫佬 · 发表于 2012-1-15 22:00:08

有没有像燕秀自动线型比例的代码

jianlin521 · 发表于 2012-6-17 22:50:26

有没有改标注比例的？可以根据所框选的范围，设定标注的与框选范围的比例?

sageman · 发表于 2013-3-21 08:28:23

能达到自动设置比例，适合让肉眼看到的比例吗？

bai2000 · 发表于 2013-4-10 11:34:37

顶起来，好像SMARTOOLS中有个自动线型比例挺好用的的，他是按屏幕的尺寸确定比例的，可惜没源码

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