【免费源代码】自动线型比例

summercad

;;; ************************************ 自动线型比例 ****************************************************
;;;
;;; 此代码由 www.summerCAD.com 开发，免费提供，请保留此说明。
;;; 【QQ群】CAD插件大全群，欢迎加入。群号： 49608623
;;;  http://shang.qq.com/wpa/qunwpa?i ... d630b29b3e646fa0b7d
;;;
;;; ************************************ 自动线型比例 ****************************************************

(princ "\n自动线型比例命令：AutoLS 或 SM_AutoLS")
(defun C:AutoLS() (sm_ltscale_auto))
(defun C:SM_AutoLS() (sm_ltscale_auto))
(defun sm_ltscale_auto(/ ss en el lay laytb lttb ltsc0 ltsc1 ltype ltlen vs tmp)
  (Command_B)
  (if(setq ss(ssget))
    (WHILE(setq        en(ssname ss 0))
      (setq ss(ssdel en ss))
      (setq el(entget en)
            lay(cdr(assoc 8 el))
            laytb(tblsearch "layer" lay)       
      )
      (if(assoc 6 el)
        (setq ltype(cdr(assoc 6 el)))                ;取线型名称
        (setq ltype(cdr(assoc 6 laytb)))
      )
      (setq lttb(tblsearch "ltype" ltype)        ;线型表
            ltlen(cdr(assoc 40 lttb))                ;线型图案总长
      )
      (if (= ltlen 0)(setq ltlen 1))
      (setq ltsc0(getvar"ltscale"))                ;全局线型比例因子
      (setq vs(getvar"viewsize"))                ;当前视口中视图的高度
      (setq ltsc1(/ vs 10 ltsc0 ltlen))
      (setq tmp(rtos ltsc1 1 4))
      (setq ltsc1(strcat(substr tmp 1 3)
                        (substr tmp (-(strlen tmp)3)4)
                 )
      )
      (setq ltsc1 (atof ltsc1))                 ;取整两位
      (if (= ltsc1 0)(setq ltsc1 1))

      (if(assoc 48 el)                                ;改实体线型比例
        (setq el(subst(cons 48 ltsc1)(assoc 48 el)el))
        (setq el(append el(list(cons 48 ltsc1))))
      )
      (entmod el)
    ) ;progn
  );if
  (Command_E)
    (princ)
)   


(defun Command_B()
  (defun tmperr(msg)
     (setq *error* nil)
     (princ msg)
     (command"_.undo""end")
     (setvar"cmdecho"_sm_old_cmd)
     (setvar"osmode"_sm_old_os)
     (setvar"blipmode"_sm_old_bmd)
     (setvar"highlight"1)
     (setvar"elevation"_sm_old_elev)
     (setvar"plinewid"_sm_old_plwid)
     (setvar"pickstyle"_sm_old_picksty)
     (setvar"cecolor" _sm_old_cecolor)
     (setvar"expert"0)
     (princ)
  )
   (setq *error* nil
        _sm_old_cmd(getvar"cmdecho")
        _sm_old_picksty(getvar"pickstyle")
        _sm_old_os (getvar"osmode")
        _sm_old_bmd(getvar"blipmode")
        _sm_old_hlt(getvar"highlight")
        _sm_old_elev(getvar"elevation")
        _sm_old_plwid(getvar"plinewid")
        _sm_old_ucsicon(getvar"ucsicon")
        _sm_old_cecolor(getvar"cecolor")
   )
   (setvar"cmdecho"0)
   (setvar"osmode"0)
   (setvar"blipmode"0)
   (setvar"thickness"0)
   (setvar"elevation"0)
   (setvar"plinewid"0)
   (setvar"pickstyle"0)
   (setvar"cecolor" "bylayer")
   (command"_.undo""group")
   (setq *error* tmperr)

)
;;=====================================
(defun Command_E()
   (command"_.undo""end")
   (setvar"cmdecho"_sm_old_cmd)
   (setvar"osmode"_sm_old_os)
   (setvar"blipmode"_sm_old_bmd)
   (setvar"highlight"1)
   (setvar"ucsicon"_sm_old_ucsicon)
   (setvar"elevation"_sm_old_elev)
   (setvar"plinewid"_sm_old_plwid)
   (setvar"pickstyle"_sm_old_picksty)
   (setvar"cecolor" _sm_old_cecolor)
   (setvar"menuctl"0)
   (setvar"expert"0)
   (setvar"pickbox"4)
   (setq *error* nil)
   (princ)
)
(princ)

summercad

bai2000

谢谢源码。老大的程序都挺好

liushengri1

谢谢源码{:soso_e183:}

liushengri1

谢谢源码{:soso_e183:}

liushengri1

谢谢源码{:soso_e183:}

xjf2100@qq.com

很好很好学习了

longer1000

谢谢源码

孤影

谢谢源代码

pezyl

谢谢发布源码

yzhyxh

lxdz443

谢发布源码