-- 编程技术交流 ( http://bbs.gissky.net/ShowForum.asp?forumid=22 )
--- 在CAD 进行智能修改功能强大 ( http://bbs.gissky.net/ShowPost.asp?id=41535 )
作者：s1yanghong
发表时间：2007-10-25 10:33:13
智能选择文本注记:--改字体、比例、字高
;;; 智能选择点:--点换成块
;;; 智能选择块:--块换成点、块换块
;;; 智能选择线:--LINE线转换成POLYLINE线
;;; 智能选择圆:--圆换成点、圆换块
;;; 其他操作：删除、改层、改颜色、改th编码、改高程值
作者：s1yanghong
发表时间：2007-11-18 13:57:28
;;; By yang hong
;;; 2003.7.11 智能选择文本注记:--改字体、比例、字高
;;; 智能选择点:--点换成块
;;; 智能选择块:--块换成点、块换块
;;; 智能选择线:--LINE线转换成POLYLINE线
;;; 智能选择圆:--圆换成点、圆换块
;;; 其他操作：删除、改层、改颜色、改th编码、改高程值
;***************************SELECT****************************
(defun de1()
(setq scal (getreal "\n选择修改内容: 0(退出) 1(删除) 2(改层) 3(改颜色) 4(改TH编码) 5(改高程值) 6(改字高) 7(改字体) 8(改比例)
<0>:"))
(if (= scal nil) (setq sca (dewall)))
(if (= scal 0) (setq sca (dewall)))
(if (= scal 1) (setq sca (dekill)))
(if (= scal 2) (setq sca (degai)))
(if (= scal 3) (setq sca (deys)))
(if (= scal 4) (setq sca (deth)))
(if (= scal 5) (setq sca (degao)))
(if (= scal 6) (setq sca (textgao)))
(if (= scal 7) (setq sca (textst)))
(if (= scal 8) (setq sca (textbl)))
)
;***************************SELECT****************************
(defun de2()
(setq scal (getreal "\n选择修改内容: 0(退出) 1(删除) 2(改层) 3(改颜色) 4(改TH编码) 5(改高程值)<0>:"))
(if (= scal nil) (setq sca (dewall)))
(if (= scal 0) (setq sca (dewall)))
(if (= scal 1) (setq sca (dekill)))
(if (= scal 2) (setq sca (degai)))
(if (= scal 3) (setq sca (deys)))
(if (= scal 4) (setq sca (deth)))
(if (= scal 5) (setq sca (degao)))
)
;***************************SELECT****************************
(defun de3()
(setq scal (getreal "\n选择修改内容: 0(退出) 1(删除) 2(改层) 3(改颜色) 4(改高程值) 5(块换成点) 6(块换成块)<0>:"))
(if (= scal nil) (setq sca (dewall)))
(if (= scal 0) (setq sca (dewall)))
(if (= scal 1) (setq sca (dekill)))
(if (= scal 2) (setq sca (degai)))
(if (= scal 3) (setq sca (deys)))
(if (= scal 4) (setq sca (degao)))
(if (= scal 5) (setq sca (khuand)))
(if (= scal 6) (setq sca (khuank)))
)
;***************************SELECT****************************
(defun de4()
(setq scal (getreal "\n选择修改内容: 0(退出) 1(删除) 2(改层) 3(改颜色) 4(改TH编码) 5(改高程值) 6(点换成块)<0>:"))
(if (= scal nil) (setq sca (dewall)))
(if (= scal 0) (setq sca (dewall)))
(if (= scal 1) (setq sca (dekill)))
(if (= scal 2) (setq sca (degai)))
(if (= scal 3) (setq sca (deys)))
(if (= scal 4) (setq sca (deth)))
(if (= scal 5) (setq sca (degao)))
(if (= scal 6) (setq sca (dhuank)))
)
;***************************SELECT****************************
(defun de5()
(setq scal (getreal "\n选择修改内容: 0(退出) 1(删除) 2(改层) 3(改颜色) 4(改TH编码) 5(改高程值) 6(转成POLYLINE线)<0>:"))
(if (= scal nil) (setq sca (dewall)))
(if (= scal 0) (setq sca (dewall)))
(if (= scal 1) (setq sca (dekill)))
(if (= scal 2) (setq sca (degai)))
(if (= scal 3) (setq sca (deys)))
(if (= scal 4) (setq sca (deth)))
(if (= scal 5) (setq sca (degao)))
(if (= scal 6) (setq sca (dezhuan1)))
)
;***************************SELECT****************************
(defun de6()
(setq scal (getreal "\n选择修改内容: 0(退出) 1(删除) 2(改层) 3(改颜色) 4(改TH编码) 5(改高程值) 6(圆换点) 7(圆换块)<0>:"))
(if (= scal nil) (setq sca (dewall)))
(if (= scal 0) (setq sca (dewall)))
(if (= scal 1) (setq sca (dekill)))
(if (= scal 2) (setq sca (degai)))
(if (= scal 3) (setq sca (deys)))
(if (= scal 4) (setq sca (deth)))
(if (= scal 5) (setq sca (degao)))
(if (= scal 6) (setq sca (yhuand)))
(if (= scal 7) (setq sca (yhuank)))
)
;
(DEFUN C:de()
;*************************CREATE WORK STATUS***************************
(setq sblip (getvar "blipmode"))
(setq scmde (getvar "cmdecho"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setvar "plinetype" 0)
;***************************SELECT SCALE****************************
(setq obj2 (car (entsel "\n**请选择:")))
(if (= obj2 nil) (setq sca (dewall)))
(setq ent (entget obj2))
(setq ced (cdr (assoc 0 ent)))
(setq cdd (cdr (assoc 8 ent)))
(if (= ced "TEXT") (setq temp "TEXT文本注记"))
(if (= ced "POLYLINE") (setq temp "POLYLINE线"))
(if (= ced "INSERT") (setq temp "块"))
(if (= ced "POINT") (setq temp "POINT点"))
(if (= ced "LINE") (setq temp "LINE线"))
(if (= ced "CIRCLE") (setq temp "圆"))
;(princ ced)
(princ "\n****您选择了<")(princ cdd)(princ ">层中所有的 <")(princ temp)(princ "> ****")
(setq dui ced)
(if (= dui "TEXT") (setq sca (de1)))
(if (= dui "POLYLINE") (setq sca (de2)))
(if (= dui "INSERT") (setq sca (de3)))
(if (= dui "POINT") (setq sca (de4)))
(if (= dui "LINE") (setq sca (de5)))
(if (= dui "CIRCLE") (setq sca (de6)))
(if (= dui nil) (setq sca (dewall)))
;*******************************************************************************
(setvar "blipmode" sblip)
(setvar "cmdecho" scmde)
(setvar "plinewid" 0)
)
;****************************************************************
(defun dezhuan1()
(setq lay cdd)
(setq hc1(ssget "x" (LIST (CONS 0 dui)(CONS 8 lay))))
(setq n 0)
(setq num(sslength hc1))
(while (< n num)
(setq hc2 (ssname hc1 n))
(command "pedit" hc2 "y" "")
(setq n(+ 1 n))
)
(princ "\n共转换了<")(princ n)(princ ">根")(princ temp)(princ "转成POLYLINE线。")
(dewall)
)
;****************************************************************
(defun dekill()
(setq lay cdd)
(setq hc1(ssget "x" (LIST (CONS 0 dui)(CONS 8 lay))))
(setq n 0)
(setq num(sslength hc1))
(while (< n num)
(setq hc2 (ssname hc1 n))
(command "erase" hc2 "" "" )
(setq n(+ 1 n))
)
(princ "\n共删除了<")(princ n)(princ ">个")(princ temp)(princ "。")
(dewall)
)
;***************************************************************
(defun degai()
(setq lay cdd)
(setq lacx (getstring "\n 输入要改成的层名:"))
(command "-layer" "m" lacx "" "")
(setq hc1(ssget "x" (LIST (CONS 0 dui)(CONS 8 lay))))
(setq n 0)
(setq num(sslength hc1))
(while (< n num)
(setq hc2 (ssname hc1 n))
(command "change" hc2 "" "p" "layer" lacx "")
(setq n(+ 1 n))
)
(princ "\n共修改了<")(princ n)(princ ">个")(princ temp)(princ "从<")(princ cdd)(princ ">层改到<")(princ lacx)(princ ">层。")
(dewall)
)
;****************************************************************
(defun deys()
(setq lay cdd)
(setq ys (getstring "\n 输入要改的颜色:"))
(setq hc1(ssget "x" (LIST (CONS 0 dui)(CONS 8 lay))))
(setq n 0)
(setq num(sslength hc1))
(while (< n num)
(setq hc2 (ssname hc1 n))
(command "change" hc2 "" "p" "c" ys "" )
(setq n(+ 1 n))
)
(princ "\n共修改了<")(princ n)(princ ">个")(princ temp)(princ "的颜色:<")(princ ys)(princ ">。")
(dewall)
)
;*************************************************
(defun deth()
(setq lay cdd)
(setq high (getreal "\n 输入高度编码:"))
(setq hc1(ssget "x" (LIST (CONS 0 dui)(CONS 8 lay))))
(setq n 0)
(setq num(sslength hc1))
(while (< n num)
(setq hc2 (ssname hc1 n))
(command "change" hc2 "" "p" "thickness" high "")
(setq n(+ 1 n))
)
(princ "\n共修改了<")(princ n)(princ ">个")(princ temp)(princ "的TH值:<")(princ high)(princ ">。")
(dewall)
)
;************************************************
(defun degao()
(setq lay cdd)
(setq lacx (getreal "\n 输入高程值:"))
(setq hc1(ssget "x" (LIST (CONS 0 dui)(CONS 8 lay))))
(setq n 0)
(setq num(sslength hc1))
(while (< n num)
(setq hc2 (ssname hc1 n))
(command "change" hc2 "" "p" "elev" lacx "")
(setq n(+ 1 n))
)
(princ "\n共修改了<")(princ n)(princ ">个")(princ temp)(princ "的高程值:<")(princ lacx)(princ ">。")
(dewall)
)
;************************************************
(defun yhuand()
(setq la_name cdd)
(princ "\n请注意块的存放路径，以便插入。")
(command "pdsize" "2")
(command "pdmode" "2")
(setq sname (ssget "X" (list (cons 8 la_name)(cons 0 "CIRCLE"))))
(setq snumb (sslength sname))
(setq n_numb 0)
(command "layer" "s" la_name "")
(while (< n_numb snumb)
(setq n_name (ssname sname n_numb))
(setq n_ent (entget n_name))
(setq insp (cdr (assoc 10 n_ent)))
; (setq insp (list (car insp)(car (cdr insp))))
(command "point" insp)
(setq n_numb (+ n_numb 1))
)
(command "erase" sname "")
(princ "\n共替换了<")(princ n_numb)(princ ">个圆，换成了<")(princ n)(princ ">点。")
(dewall)
)
;************************************************
(defun yhuank()
(setq la_name cdd)
(princ "\n请注意块的存放路径，以便插入。")
(setq blkn (getstring "\n 块名:"))
(setq insc (getreal "\n 插入比例:"))
(setq inc (getreal "\n 插入角度:"))
(setq sname (ssget "X" (list (cons 8 la_name)(cons 0 "CIRCLE"))))
(setq snumb (sslength sname))
(setq n_numb 0)
(command "layer" "s" la_name "")
(while (< n_numb snumb)
(setq n_name (ssname sname n_numb))
(setq n_ent (entget n_name))
(setq insp (cdr (assoc 10 n_ent)))
; (setq insp (list (car insp)(car (cdr insp))))
(command "insert" blkn insp insc insc inc)
(setq n_numb (+ n_numb 1))
)
(command "erase" sname "")
(princ "\n共替换了<")(princ n_numb)(princ ">个圆，换成了<")(princ blkn)(princ ">块。")
(dewall)
)
;************************************************
(defun dhuank()
(setq la_name cdd)
(princ "\n请注意块的存放路径，以便插入。")
(setq blkn (getstring "\n 块名:"))
(setq insc (getreal "\n 插入比例:"))
(setq inc (getreal "\n 插入角度:"))
(setq sname (ssget "X" (list (cons 8 la_name)(cons 0 "point"))))
(setq snumb (sslength sname))
(setq n_numb 0)
(command "layer" "s" la_name "")
(while (< n_numb snumb)
(setq n_name (ssname sname n_numb))
(setq n_ent (entget n_name))
(setq insp (cdr (assoc 10 n_ent)))
; (setq insp (list (car insp)(car (cdr insp))))
(command "insert" blkn insp insc insc inc)
(setq n_numb (+ n_numb 1))
)
(command "erase" sname "")
(princ "\n共替换了<")(princ n_numb)(princ ">个点，换成了<")(princ blkn)(princ ">块。")
(dewall)
)
;************************************************
(defun khuank()
(setq la_name cdd)
(princ "\n请注意块的存放路径，以便插入。")
(setq blkn (getstring "\n 块名:"))
(setq insc (getreal "\n 插入比例:"))
(setq inc (getreal "\n 插入角度:"))
(setq sname (ssget "X" (list (cons 8 la_name)(cons 0 "insert"))))
(setq snumb (sslength sname))
(setq n_numb 0)
(command "layer" "s" la_name "")
(while (< n_numb snumb)
(setq n_name (ssname sname n_numb))
(setq n_ent (entget n_name))
(setq insp (cdr (assoc 10 n_ent)))
; (setq insp (list (car insp)(car (cdr insp))))
(command "insert" blkn insp insc insc inc)
(setq n_numb (+ n_numb 1))
)
(command "erase" sname "")
(princ "\n共替换了<")(princ n_numb)(princ ">个块，换成了<")(princ blkn)(princ ">块。")
(dewall)
)
;************************************************
(defun khuand()
(setq la_name cdd)
(princ "\n请注意块的存放路径，以便插入。")
(command "pdsize" "2")
(command "pdmode" "2")
(setq sname (ssget "X" (list (cons 8 la_name)(cons 0 "insert"))))
(setq snumb (sslength sname))
(setq n_numb 0)
(command "layer" "s" la_name "")
(while (< n_numb snumb)
(setq n_name (ssname sname n_numb))
(setq n_ent (entget n_name))
(setq insp (cdr (assoc 10 n_ent)))
; (setq insp (list (car insp)(car (cdr insp))))
(command "point" insp)
(setq n_numb (+ n_numb 1))
)
(command "erase" sname "")
(princ "\n共替换了<")(princ n_numb)(princ ">个块，换成了<")(princ n)(princ ">点。")
(dewall)
)
;************************************************
(defun textxg()
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq la_name cdd)
(setq an (getreal "\n 修改角度:"))
(setq st (getstring "\n 修改字体:"))
(setq bl (getreal "\n 修改比例:"))
(setq zg (getreal "\n 修改字高:"))
(setq an (* (/ an 180) 3.1415926))
(setq hc1 (ssget "x" (list (cons 0 "TEXT")(cons 8 la_name))))
(setq hcnum (sslength hc1))
(setq n 0)
(while (< n hcnum)
(setq hc2 (ssname hc1 n))
(setq hc2 (entget hc2))
(setq hc5 (assoc 41 hc2))
(SETQ HC4 (ASSOC 7 HC2))
(SETQ HC6 (ASSOC 40 HC2))
(SETQ HC7 (ASSOC 50 HC2))
(setq hc2 (subst (cons 7 st) hc4 hc2))
(setq hc2 (subst (cons 41 bl) hc5 hc2))
(setq hc2 (subst (cons 40 zg) hc6 hc2))
(setq hc2 (subst (cons 50 an) hc7 hc2))
(entmod hc2)
(setq n (+ n 1))
)
(dewall)
)
;************************************************
(defun textgao()
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq la_name cdd)
(setq zg (getreal "\n 修改字高:"))
(setq hc1 (ssget "x" (list (cons 0 "TEXT")(cons 8 la_name))))
(setq hcnum (sslength hc1))
(setq n 0)
(while (< n hcnum)
(setq hc2 (ssname hc1 n))
(setq hc2 (entget hc2))
(setq hc5 (assoc 41 hc2))
(SETQ HC4 (ASSOC 7 HC2))
(SETQ HC6 (ASSOC 40 HC2))
(SETQ HC7 (ASSOC 50 HC2))
(setq hc2 (subst (cons 40 zg) hc6 hc2))
(entmod hc2)
(setq n (+ n 1))
)
(princ "\n共修改了<")(princ n)(princ ">个字的字高:<")(princ zg)(princ ">。")
(dewall)
)
;************************************************
(defun textst()
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq la_name cdd)
(setq st (getstring "\n 修改字体:"))
(setq hc1 (ssget "x" (list (cons 0 "TEXT")(cons 8 la_name))))
(setq hcnum (sslength hc1))
(setq n 0)
(while (< n hcnum)
(setq hc2 (ssname hc1 n))
(setq hc2 (entget hc2))
(setq hc5 (assoc 41 hc2))
(SETQ HC4 (ASSOC 7 HC2))
(SETQ HC6 (ASSOC 40 HC2))
(SETQ HC7 (ASSOC 50 HC2))
(setq hc2 (subst (cons 7 st) hc4 hc2))
(entmod hc2)
(setq n (+ n 1))
)
(princ "\n共修改了<")(princ n)(princ ">个字的字体:<")(princ st)(princ ">。")
(dewall)
)
;************************************************
(defun textbl()
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setq la_name cdd)
(setq bl (getreal "\n 修改比例:"))
(setq hc1 (ssget "x" (list (cons 0 "TEXT")(cons 8 la_name))))
(setq hcnum (sslength hc1))
(setq n 0)
(while (< n hcnum)
(setq hc2 (ssname hc1 n))
(setq hc2 (entget hc2))
(setq hc5 (assoc 41 hc2))
(SETQ HC4 (ASSOC 7 HC2))
(SETQ HC6 (ASSOC 40 HC2))
(SETQ HC7 (ASSOC 50 HC2))
(setq hc2 (subst (cons 41 bl) hc5 hc2))
(entmod hc2)
(setq n (+ n 1))
)
(princ "\n共修改了<")(princ n)(princ ">个字的比例:<")(princ bl)(princ ">。")
(dewall)
)
;************************************************
(defun dewall()
(princ "\n...............................................................")
(princ "\n***谢谢使用智能选择v2.0版！*
(princ "\n ")
)
;******************
(princ "\n*********智能选择v2.0版程序编写：阳红.命令：(de)。*********")
(princ "\n.")
将上面文件copy到记事本中。改成 .lsp
作者：liaoliang08
发表时间：2007-11-18 22:18:34
强捍
