明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4522|回复: 11

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

[复制链接]
发表于 2010-4-30 23:45 | 显示全部楼层 |阅读模式

大家好  我这有一个非常好的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

发表于 2018-11-19 11:24 | 显示全部楼层
不错的代码。
发表于 2010-7-26 08:24 | 显示全部楼层
怎样自动改变直线,圆等的线形比例?比如说我把图比例放大它也能自动调整线性比例?
发表于 2010-7-26 11:29 | 显示全部楼层
  1. (defun c:tt (/ scale ss n k obj)
  2.   (setq scale (getreal "\n输入线型转换比例"))
  3.   (if (not scale) (exit))
  4.   (princ  "\n选择要转换线型比例的实体:")
  5.   (setq ss (ssget))
  6.   (if ss
  7.     (progn
  8.       (setq n (sslength ss)
  9.      k 0)
  10.       (repeat n
  11.       (setq obj (vlax-ename->vla-object (ssname ss k)))
  12.       (setq newscale (* scale (vla-get-LinetypeScale obj)))
  13.       (vla-put-linetype obj "dashed")
  14.       (vla-put-LinetypeScale obj newscale)
  15.       (setq k (1+ k))
  16.       )
  17.       )
  18.     )
  19.   )
发表于 2011-1-5 23:26 | 显示全部楼层
              Gu_xl  的程序如能自动根据实体的长度来判断比例就好了
发表于 2011-1-6 15:51 | 显示全部楼层
xyz2009xyz 发表于 2010-7-26 08:24
怎样自动改变直线,圆等的线形比例?比如说我把图比例放大它也能自动调整线性比例?

这个好像不好实现
发表于 2011-12-18 11:01 | 显示全部楼层
请帮忙顶起
发表于 2012-1-15 22:00 | 显示全部楼层
有没有像燕秀自动线型比例的代码
发表于 2012-6-17 22:50 | 显示全部楼层
有没有改标注比例的?  可以根据所框选的范围,设定标注的与框选范围的比例?
发表于 2013-3-21 08:28 | 显示全部楼层
能达到自动设置比例,适合让肉眼看到的比例吗?
发表于 2013-4-10 11:34 | 显示全部楼层
顶起来,好像SMARTOOLS中有个自动线型比例挺好用的的,他是按屏幕的尺寸确定比例的,可惜没源码
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 17:14 , Processed in 0.267461 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表