lisp 编程例子

;;======================================================================================
(defun C:Cas()
(gc)
(textscr)
(princ "\n\n\n\n\n\n;;*************** Cass5.0扩展工具 *****************")
(princ "\n;;CC 打开选择实体所在图层,关闭其他层.")
(princ "\n;;ZZ 关闭选择实体所在图层.")
(princ "\n;;VV 显示添加的图层.")
(princ "\n;;CB 将图形颜色BYLAYER")
(princ "\n;;PLJ 将输入图层的LINE 或LWPOLYLINE;连接成LWPOLYLINE")
(princ "\n;;COP 将选择的实体复制放在\"0\"层.")
(princ "\n;;EPL 选择没闭合的LWPOLYLINE,将其闭合(构面)")
(princ "\n;;CHKGM 检测面状地物是否构面,如果没构面将其颜色该为(品红=6).")
(princ "\n;;CHKSX 检测Building层属性是否完全,如果不全将其颜色该为(品红=6).")
(princ "\n;;ADDF1 将Building层属性为空值的实体加上\"-1\".")
(princ "\n;;3DP 外业数据展点程序(直接转换到CASS5.0入库格式).")
(princ "\n;;POINTSX 将已形成DWG文件的\"SZS\"直接转换到CASS5.0入库格式.")
(princ "\n;;XLIST 察看扩展数据(单个实体).")
(princ "\n;;XDATA 加入扩展数据(单个实体).")
(princ "\n;;LIS 察看实体DXF数据(单个实体)")
(princ "\n;;NPP 根据所选实体的文本或已有属性的房屋NAME,将再次选择的房屋加入该属性.")
(princ "\n;;QPP 将所选实体的属性复制给其它实体[KID植除外].")
(princ "\n;;CHJG 将所选房屋的[结构暂缺]= -1 的实体改为[结构其它]= 0.")
(princ "\n;;CHYT 将所选房屋的[用途暂缺]= -1 的实体改为[结构 其它= 0,住宅=100,办公=101,商业=102].")
(princ "\n;;CHKID 将KID置[0].")
(princ "\n;;MapTF500在Autodesk Map下裁500图.")
(princ "\n;;MTR Map下裁剪.")
(princ "\n;;PCH 批量处理***.")
(princ "\n;;UD 将实体置上或置下.")
(princ "\n;;ER 关闭其它层打开ERROR层.")
(princ "\n;;CSTK 加CASS图廓.")
(princ "\n;;CHKE 检查非法图层、块、线型.")
(princ "\n;;CHKT 检查TYPE的值即CODE与LAYER是否匹配.")
(princ "\n;;HDP 幻灯片--浏览图形")
(princ "\n;;CHKC 查找无Code值的实体")
(princ "\n;;********************* Cadtools10000 ************************")
(princ "\n;;WQ 1:1000围墙符号.")
(princ "\n;;LS 1:1000栅栏符号.")
(princ "\n;;GX1 1:1000管线符号.")
(princ "\n;;GX2 1:1000管线符号.")
(princ "\n;;DX 1:1000电线符号.")
(princ "\n;;KAN 1:1000陡坎符号.")
(princ "\n;;GJK 1:500加固坎符号.")
(princ "\n;;HSLB 1:500活树篱笆符号.")
(princ "\n;;MD 1:500门墩符号.")
(princ "\n;;FT 1:500扶梯符号.")
(princ "\n;;TJ 1:500台阶符号.")
(princ "\n;;IZ 1:500植被成组注记.")
(princ "\n;;SLAYER 1:500加入环境.")
(princ "\n;;FX 1:500棚房、桥符号.")
(princ "\n;;GC1 1:500一位高程#.#.")
(princ "\n;;GC2 1:500二位高程#.##.")

(princ "\n;;GC3 1:500三位高程#.###.")
(princ "\n;;JZB 极坐标计算程序.")
(princ "\n;;C_CHANGE 文字,块等批量修改程序.")
(princ "\n;;ZDM 纵断面生成程序.")
(princ "\n;;HDM 横断面生成程序.")
(princ "\n;;SEARCH 文字,块等查找程序.")
(princ "\n;;PPP 展点程序,原3DP程序.")
(princ "\n;;SHOWH 将具有3维坐标块\"SZS\"的高程展在图上.")
(princ "\n;;TQ 提取图形中的文字并形成文件程序.")
(princ "\n;;ZJT 将提取图形中的文字注记到图形中程序,TQ的逆运算.")
(princ "\n;;SX 将选取实体的线型该为CONTINUOUS.")
(princ "\n;;XX 将选取实体的线型该为DASH1.")
(princ "\n;;DB 将选取的直线单点打断.")
(princ "\n;;GD 将选高、低压线互换711A<==>712A.")
(princ "\n;;SAVER14TOR12 将R14格式另存为R12格式.")
(princ "\n;;DB 将选取的直线单点打断.")
(princ "\n;;DELDH 删除点号.")
(princ "\n;;HXYS 提取红线元素.")
(princ "\n;;NXY 提取点名、x、y.")
(princ "\n;;HU 求弧长.")
(princ "\n;;LC 里程标注.")
(princ "\n;;XY 在图上注记X,Y坐标.")
(princ "\n;;3WTO2W 三维变贰维.")
(princ "\n;;CPL 炸碎多义线.")
(princ "\n;;PLJ 将指定图层的线或多义线连接成多义线.")
(princ "\n;;ZSWZ 炸碎文字.")
(princ "\n;;ZSTXT 炸碎文字,和ZSWZ一样.")
(princ "\n;;HBWZ 合并文字.")
(princ "\n;;WBK 写块并打开该图 ")
(princ "\n;;HTOV 水平注记的文字变成垂直注记.")
(princ "\n;;TFH500 在所选的图面位置注记1:500图号.")
(princ "\n;;TFX500 在所选的图面范围内注记1:500图号,并画出分幅线.")
(princ "\n;;TFX1000 在所选的图面范围内注记1:1000图号,并画出分幅线.")
(princ "\n;;TFX2000 在所选的图面范围内注记1:2000图号,并画出分幅线.")
(princ "\n;;TK500 在所选的图面加注1:500图廓线.")
(princ "\n;;TK1000 在所选的图面加注1:1000图廓线.")
(princ "\n;;TK2000 在所选的图面加注1:2000图廓线.")
(princ "\n;;TF500 将所选的图面按1:500分幅切割成分幅图并存到C:MAPLIB目录下(应先建立该目录).")
(princ "\n;;TF1000 将所选的图面按1:1000分幅切割成分幅图并存到C:MAPLIB目录下(应先建立该目录).")
(princ "\n;;TF2000 将所选的图面按1:2000分幅切割成分幅图并存到C:MAPLIB目录下(应先建立该目录).")
(princ "\n;;ADD 选择包含数字的字符串相加减.")
(princ "\n;;C2 选择包含数字的字符串除以2.0.")
(princ "\n;;STS 将文本缩放x倍")
(princ "\n;;********************** 说明 *************************")
(princ "\n;; 1:500或1:1000如果想进入那一层,直接输入该层文字,如:87")
(princ "\n;; 1:500或1:1000如果想改注记的高度,直接输入T??,然后再选该文字即可如:T25,T07等")
(princ "\n;;*******************************************************")
(princ)
)

;;======================================================================================
(defun c:hj()
(gc)
(command "-insert" "cass50" (list 0 0) "" "" "")
(princ "\n 已成功加入CASS环境!!!")
)
(defun c:cm()
(gc)
(princ "\n 查看实体编码:")
(command "getp")
)
(defun c:jm()
(gc)
(princ "\n 加入实体编码:")
(command "putp")
)
(defun c:sre()
(gc)
(princ "\n 重新生成:")
(command "recass")
)
(defun c:jd()
(gc)
(princ "\n 多义线加点:")
(command "polyins")
)
(defun c:sd()
(gc)
(princ "\n 多义线删加点:")
(command "erasevertex")
)
(defun c:sr()
(gc)
(princ "\n 输入XDB文件:")
(command "readsmi")
)
(defun c:scs()
(gc)
(princ "\n 输出XDB文件:")
(command "writesmi")
)
(defun c:ns()
(gc)
(princ "\n 新建XDB文件:")
(command "newxdb")
)
(defun c:cs()
(gc)
(princ "\n 查看SMI信息:")
(command "smiinfo")
)
(defun c:xs()
(gc)
(princ "\n 修改SMI信息:")
(command "modiinfo")
)
(defun c:js()
(gc)
(princ "\n 加入SMI[房屋]信息:")
(command "smibuilding")
)
(defun c:nsx()
(gc)
(princ "\n 过滤无属性实体:")
(command "guolv")
)
(defun c:fb()
(gc)
(princ "\n 面状封闭检查:")
(command "checkclose")
)
(defun c:fw()
(gc)
(princ "\n 画房屋:")
(command "dd" "2113")
)
(defun c:pf()
(gc)
(princ "\n 画棚房:")
(command "dd" "141500")
)
(defun c:jf()
(gc)
(princ "\n 画简易房屋:")
(command "dd" "141200")
)
(defun c:swq()
(gc)
(princ "\n 画围墙:")
(command "dd" "144300")
)
(defun c:sls()
(gc)
(princ "\n 画围墙:")
(command "dd" "144400")
)
(defun c:smd()
(gc)
(princ "\n 画门墩:")
(command "dd" "143910")
)
(defun c:stj()
(gc)
(princ "\n 画台阶:")
(command "smilt")
)
(defun c:szz()
(gc)
(princ "\n 画支柱:")
(command "dd" "143902")
)
(defun c:st1()
(gc)
(princ "\n 画台无注记:")
(command "dd" "153800")
)
(defun c:st2()
(gc)
(princ "\n 画台有注记[台]:")
(command "dd" "153801")
)
(defun c:sdj()
(gc)
(princ "\n 画地类界:")
(command "dd" "216100")
)
(defun c:shp()
(gc)
(princ "\n 画花圃:")
(command "dd" "215400")
)
(defun c:sgx()
(gc)
(princ "\n 高压线:")
(command "smigkg" "1")
)
(defun c:sdx()
(gc)
(princ "\n 低高压线:")
(command "smigkg" "2")
)
(defun c:stx()
(gc)
(princ "\n 通信线:")
(command "smigkg" "3")
)
(defun c:752()
(gc)
(princ "\n 消火栓:")
(command "dd" "175200")
)
(defun c:741()
(gc)
(princ "\n 上水检修井:")
(command "dd" "174100")
)
(defun c:742()
(gc)
(princ "\n 下水检修井:")
(command "dd" "174200")
)
(defun c:751b()
(gc)
(princ "\n 雨蓖子:")
(command "dd" "175102")
)
(defun c:5521()
(gc)
(princ "\n 路灯:")
(command "dd" "155210")
)
(defun c:747()
(gc)
(princ "\n 电力检修井:")
(command "dd" "174700")
)
(defun c:716()
(gc)
(princ "\n 变压器:")
(command "dd" "171610")
)
(defun c:744()
(gc)
(princ "\n 煤气:")
(command "dd" "174400")
)
(defun c:746a()
(gc)

(princ "\n 煤气:")
(command "dd" "174601")
)
(defun c:717a()
(gc)
(princ "\n 电力入地:")
(command "dd" "171700")
)
(defun c:717b()
(gc)
(princ "\n通讯线入地:")
(command "dd" "172004")
)
(defun c:718a()
(gc)
(princ "\n变电室符号:")
(command "dd" "171811")
)
(defun c:713()
(gc)
(princ "\n电杆:")
(command "dd" "171300")
)
(defun c:656a()
(gc)
(princ "\n里程碑:")
(command "dd" "165601")
)
(defun c:656c()
(gc)
(princ "\n指示牌:")
(command "dd" "165603")
)
(defun c:656d()
(gc)
(princ "\n站点:")
(command "dd" "165604")
)
(defun c:125()
(gc)
(princ "\n电车拉杆:")
(command "dd" "165605")
)
(defun c:126()
(gc)
(princ "\n信号灯:")
(command "dd" "165606")
)
(defun c:127()
(gc)
(princ "\n邮筒:")
(command "dd" "165607")
)
(defun c:1213()
(gc)
(princ "\n单柱广告牌:")
(command "dd" "165608")
)
(defun c:834()
(gc)
(princ "\n出水口:")
(command "dd" "183401")
)
(defun c:811c1()
(gc)
(princ "\n流向:")
(command "dd" "181105")
)
(defun c:122()
(gc)
(princ "\n斜坡符号:")
(command "dd" "140100")
)
(defun c:553()
(gc)
(princ "\n喷水池:")
(command "dd" "155300")
)
(defun c:563b()
(gc)
(princ "\n雕相:")
(command "dd" "156302")
)
(defun c:564()
(gc)
(princ "\n旗杆:")
(command "dd" "156400")
)
(defun c:551()
(gc)
(princ "\n加油站:")
(command "dd" "155100")
)
(defun c:555()
(gc)
(princ "\n垃圾房:")
(command "dd" "155500")
)
(defun c:559()
(gc)
(princ "\n避雷针:")
(command "dd" "155900")
)
(defun c:527a()
(gc)
(princ "\n烟窗:")
(command "dd" "152700")
)
(defun c:3230()
(gc)
(princ "\n露天设备:")
(command "dd" "3230")
)
(defun c:sgg()
(gc)
(princ "\n依比例广告牌:")
(command "smiggp")
)
(defun c:L10()
(gc)
(princ "\n城市道路:")
(command "dd" "163200")
)
(defun c:L87()
(gc)
(princ "\n内部道路:")
(command "dd" "164400")
)
(defun c:qa()
(gc)
(princ "\n桥边线:")
(command "dd" "166010")
)
(defun c:he()
(gc)
(princ "\n河流:")
(command "dd" "180003")
)
(defun c:ba()
(gc)
(princ "\n浜:")
(command "dd" "182402")
)
(defun c:qu()
(gc)
(princ "\n渠:")
(command "dd" "183102")
)
(defun c:szs()
(gc)
(princ "\n十字丝:")
(command "dd" "139002")
)
(defun c:zj()
(gc)
(princ "\n注记:")
(command "smitext")
)
(defun c:sgc1()
(gc)
(princ "\n散点高程:")
(command "dd" "202101")
)
(defun c:sgc2()
(gc)
(princ "\n道路高程:")
(command "dd" "202102")
)
(defun c:mp()
(gc)
(princ "\n门牌号:")
(command "smidoorplate")
)
;;=================================================================================

(defun c:pinsert( / sa x y Dir if10000 ifxx mx1 mx2 )

(gc)
(setvar "CMDECHO" 0)
(setq Dir(getvar "DWGPREFIX"))
(setq sa(getpoint "\n Select a point to Insert a maping:"))
(setq y(car sa))
(setq x(cadr sa))
(setq if10000 0)

;;if10000

(if (and(= (findfile mx1) nil)(= (findfile nnn) nil))
(progn
(setq if500 -1)
(setq x (car sa))
(setq y (cadr sa))
(if (and (> x 0) (> y 0))
(setq x1 (* (fix (/ x 500)) 500)
y1 (* (fix (/ y 400)) 400)
tfxx "E"
m (+ (abs (/ x1 500)) 1)
n (+ (abs (/ y1 400)) 1))
)
(if (and (> x 0) (< y 0))
(setq x1 (* (fix (/ x 500)) 500)
y1 (- (* (fix (/ y 400)) 400) 400)
tfxx "F"
m (+ (abs (/ x1 500)) 1)
n (abs (/ y1 400)))
)
(if (and (< x 0) (< y 0))
(setq x1 (- (* (fix (/ x 500)) 500) 500)
y1 (- (* (fix (/ y 400)) 400) 400)
tfxx "G"
m (abs (/ x1 500))
n (abs (/ y1 400)))
)
(if (and (< x 0) (> y 0))
(setq x1 (- (* (fix (/ x 500)) 500) 500)
y1 (* (fix (/ y 400)) 400)
tfxx "H"
m (abs (/ x1 500))
n (+ (abs (/ y1 400)) 1))
)
(setq mx1(- (* m 2) 1))
(setq mx2(+ mx1 1))
(setq my1(- (* n 2) 1))
(setq my2(+ my1 1))
(setq mx1(rtos mx1 2 0))
(setq mx2(rtos mx2 2 0))
(setq my1(rtos my1 2 0))
(setq my2(rtos my2 2 0))
(if(= (strlen mx1) 1)(setq mmx1(strcat "00" mx1)))
(if(= (strlen mx1) 2)(setq mmx1(strcat "0" mx1)))
(if(= (strlen mx1) 3)(setq mmx1 mx1))
(if(= (strlen my1) 1)(setq mmy1(strcat "00" my1)))
(if(= (strlen my1) 2)(setq mmy1(strcat "0" my1)))
(if(= (strlen my1) 3)(setq mmy1 my1))
(setq nn1000(strcat Dir tfxx my1 "_" mx1 ".DWG"))
(setq nnn1000(strcat Dir tfxx mmy1 "_" mmx1 ".DWG"))
(if (/= (findfile nn1000) nil) (command "insert" nn1000 (list 0 0 0) 1 1 0.0 ))
(if (and(= (findfile nn1000) nil)(/= (findfile nnn1000) nil))(command "insert" nnn1000 (list 0 0 0) 1 1 0.0 ))
)
)
;;if2000
(if (and(= (findfile nn1000) nil)(= (findfile nnn1000) nil)(= if500 -1))
(progn
(setq if1000 -1)
(setq x (car sa))
(setq y (cadr sa))
(if (and (> x 0) (> y 0))
(setq x1 (* (fix (/ x 1000)) 1000)
y1 (* (fix (/ y 800)) 800)
tfxx "I"
m (+ (abs (/ x1 1000)) 1)
n (+ (abs (/ y1 800)) 1))
)
(if (and (> x 0) (< y 0))
(setq x1 (* (fix (/ x 1000)) 1000)
y1 (- (* (fix (/ y 800)) 800) 800)
tfxx "J"
m (+ (abs (/ x1 1000)) 1)
n (abs (/ y1 800)))
)
(if (and (< x 0) (< y 0))

(setq x1 (- (* (fix (/ x 1000)) 1000) 1000)
y1 (- (* (fix (/ y 800)) 800) 800)
tfxx "K"
m (abs (/ x1 1000))
n (abs (/ y1 800)))
)
(if (and (< x 0) (> y 0))
(setq x1 (- (* (fix (/ x 1000)) 1000) 1000)
y1 (* (fix (/ y 800)) 800)
tfxx "L"
m (abs (/ x1 1000))
n (+ (abs (/ y1 800)) 1))
)
(setq mx1(- (* m 4) 3))
(setq mx2(+ mx1 3))
(setq my1(- (* n 4) 3))
(setq my2(+ my1 3))
(setq mx1(rtos mx1 2 0))
(setq mx2(rtos mx2 2 0))
(setq my1(rtos my1 2 0))
(setq my2(rtos my2 2 0))
(if(= (strlen mx1) 1)(setq mmx1(strcat "00" mx1)))
(if(= (strlen mx1) 2)(setq mmx1(strcat "0" mx1)))
(if(= (strlen mx1) 3)(setq mmx1 mx1))
(if(= (strlen my1) 1)(setq mmy1(strcat "00" my1)))
(if(= (strlen my1) 2)(setq mmy1(strcat "0" my1)))
(if(= (strlen my1) 3)(setq mmy1 my1))
(setq nn2000(strcat Dir tfxx my1 "_" mx1 ".DWG"))
(setq nnn2000(strcat Dir tfxx mmy1 "_" mmx1 ".DWG"))
(if (/= (findfile nn2000) nil) (command "insert" nn2000 (list 0 0 0) 1 1 0.0 ))
(if (and(= (findfile nn2000) nil)(/= (findfile nnn2000) nil))(command "insert" nnn2000 (list 0 0 0) 1 1 0.0 ))
(if (and(= (findfile nn2000) nil)(= (findfile nnn2000) nil))(setq if2000 -1))
)
)
(if(and(= if500 -1)(= if1000 -1)(= if2000 -1))
(alert (strcat "\n 文件(1:500 A,B,C,D)(1:1000 E,F,G,H)(1:2000 I,J,K,L):\n " nn " \n 或 " nnn "\n 或 " nn1000 "\n 或 " nnn1000 "\n 或 " nn2000 "\n 或 " nnn2000 "\n 未找到."))
)
(princ)
)
;;======================================================================================
(defun c:dinsert( / js fn dir fn_list ifn)
(gc)
(vl-load-com)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq js 0)
(setq fn(getfiled "在要批量插入图幅的目录内任选一幅图" "" "DWG" 2))
(setq dir (vl-filename-directory fn))
(setq fn_list(vl-directory-files dir "*.DWG" 1))
(princ "\n\n -------下列为插入的文件列表:---------\n")
(foreach fn fn_list
(setq ifn(strcat dir "\\" fn))
(command "insert" ifn (list 0 0 0) 1 1 0.0 )
(setq js(+ js 1))
(princ "\n NO.[ ")(princ js)(princ " ] ")(princ fn)
)
(command "zoom" "e")
(princ "\n\n 插入的图幅数为: ")(princ js)(princ " 幅")
(princ "\n -------------------------------------")
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
)
;;======================================================================================
(defun c:lis( / a b)
(gc)
(setq a (entsel "select a entity:"))
(setq b (entget(car a)))
(princ "\n")
(princ b)
(princ)
)
;;========

===============================================================================
(defun c:cb()
(gc)
(command "change" "all" "" "p" "c" "bylayer" "")
(command "linetype" "s" "bylayer" "")
(command "color" "bylayer" "")
(princ)
)
;;=======================================================================================
(defun c:CC()
(gc)
(command "layer" "on" "*" "")
;;;; (command "layer" "t" "*" "")
;;;; (command "layer" "s" "0" "")
(setq ce (cdr (assoc 8 (entget (car (entsel "\n**选择要检查的层为打开层**"))))))
(command "layer" "s" ce "")
(command "layer" "off" "*" "" "on" ce "")
;;;; (command "layer" "off" "*" "" "on" "91" "")
)
(defun c:VV()
(gc)
(setq cce (getstring "\n输入要添加的层名:>"))
(command "layer" "on" cce "")
)
(defun c:ZZ()
(gc)
;;;; (command "layer" "s" "0" "")
(setq ce (cdr (assoc 8 (entget (car (entsel "\n**选择要关闭的层**"))))))
(command "layer" "off" ce "")
)
(defun c:ER()
(gc)
(command "layer" "s" "0" "")
(command "layer" "off" "*" "" "on" "ERROR" "")
)
(defun c:LD()
(gc)
(command "layer" "s" "0" "")
(command "layer" "off" "LAND_CLASSIFICATION" "")
)
;;========================================================================================
(defun C:CASSERR()
(if (null (tblsearch "layer" "TEMP")) (command ".layer" "make" "TEMP" "C" "6" "TEMP" "")(princ))
;;Line=>TEMP
(setq ss(ssget "X" '((8 . "0")(0 . "LINE"))))
(if(/= ss nil)(command "change" ss "" "p" "la" "TEMP" ""))
(setq ss(ssget "X" '((8 . "BUILDING")(0 . "LINE"))))
(if(/= ss nil)(command "change" ss "" "p" "la" "TEMP" ""))

(princ)
)
;;join line to polyline=======================================================
(defun c:plj(/ plj_ss ent_list la name ss len i entname m70 ent plj_layer plj_i ent plj_la)
(gc)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
;(command "layer" "on" "*" "")
(setq ent nil)
(princ "\n\n 选择要连接的实体:")
(setq plj_ss(ssget))
(setq ss(ssadd))
(setq plj_i(getstring"\n 输入要连接的实体所在图层[P-选取所在图层任一实体 / L输入图层:< P >"))
(setq plj_i(strcase plj_i T))
(if(= plj_i "l")(setq plj_la(getstring"\n 输入要连接的实体所在图层:")))
(if(or(= plj_i "p")(= plj_i "")(= plj_i " ")(= plj_i nil))(setq ent(entsel"\n 选取所在图层任一实体:")))
(if(/= ent nil)
(progn
(setq ent_list (entget (car ent)))
(setq plj_la (cdr (assoc 8 ent_list)))
)
)
(setq plj_la(strcase plj_la T))

(if (/= plj_ss nil)
(progn
(setq len (sslength plj_ss))
(setq i 0)
(while (< i len)
(setq entname (ssname plj_ss i))
(setq ent_list(entget entname))
(setq name (cdr (assoc 0 ent_list)))
(setq la (cdr (assoc 8 ent_list)))
(setq la(strcase la T))
(if(and(or(= name "LINE")(= name "ARC")(= name "LWPOLYLINE")(= name "POLYLINE"))(= la plj_la))(se

tq ss(ssadd entname ss)))
(setq i (+ i 1))
)
)
)
(setq plj_layer "tmp_layer")
(if(= (tblsearch "layer" plj_layer) nil)(command "layer" "m" plj_layer ""))
(if(/= ss nil)(command "change" ss "" "p" "la" plj_layer ""))

(if (/= (tblsearch "layer" plj_layer) nil)(cpl plj_layer))
(if (/= (tblsearch "layer" plj_layer) nil)(j plj_layer))
(setq ss (ssget "x" (list (cons -4 "(cons -4 "")
(cons -4 "")
(cons -4 "or>"))))
(if (/= ss nil)
(progn
(setq len (sslength ss))
(setq i 0)
(while (< i len)
(setq entname (ssname ss i))
(command "pedit" entname "L" "ON" "x")
(setq i (+ i 1))
)
)
)
;(setq ss nil)
;(setq ss (ssget "x" (list (cons -4 "; (cons -4 "")
; (cons -4 "")
; (cons -4 "or>"))))
;(if (/= ss nil)
; (progn
; (setq len (sslength ss))
; (setq i 0)
; (while (< i len)
; (setq entname (ssname ss i))
; (setq ent (entget entname))
; (setq m70 (cdr (assoc 70 ent)))
; ;(if(and (/= m70 129)(/= m70 1)(/= (assoc 70 ent) nil))(setq ent(subst (cons 70 128) (assoc 70 ent) ent)))
; ;(if(= (assoc 70 ent) nil)(setq ent (append '((70 . 128)) ent)))
; (if(and (/= m70 129)(/= m70 1)(/= (assoc 70 ent) nil))(setq ent(subst (cons 70 0) (assoc 70 ent) ent)))
; (if(= (assoc 70 ent) nil)(setq ent (append '((70 . 0)) ent)))
; (entmod ent)
; (setq i (+ i 1))
; )
; )
;)
(setq ss (ssget "x" '( (8 . "tmp_layer")) ))
(if(/= ss nil)(command "change" ss "" "p" "la" plj_la ""))
(command "purge" "la" "tmp_layer" "y" "y")
(setq ss nil)
(command "regen")
(setvar "cmdecho" cmd)
);;defun
;;---------------------subp for join line-----------------------------
(defun j(sla / ss ent_list sstmp pd)
(gc)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if(= (tblsearch "layer" "tmp") nil)(command "layer" "m" "tmp" ""))
(while (/= (setq ss (ssget "x" (list (cons -4 "(cons -4 "")
(cons -4 "")
(cons -4 "")
(cons -4 "")
(cons -4 "or>")
) )) nil)
(setq entname (ssname ss 0))
(setq ent_list(entget entname))
(setq pd (cdr (assoc 0 ent_list)))
(if (or (= pd "LINE")(= pd "ARC"))(command "pedit" entname "Y" "J" SS "" "x"))
(if (= pd "

LWPOLYLINE")(command "pedit" entname "J" SS "" "x"))
(princ "\r")(princ "layer is: ")(princ sla)(princ " ")(princ pd)
(if(/= entname nil)(command "change" "l" "" "p" "la" "tmp" ""))
)
(command "layer" "s" "0" "")
(setq sstmp(ssget "x" '((8 . "tmp"))))
(command "change" sstmp "" "p" "la" sla "")
(command "purge" "la" "tmp" "y" "y")
(setq ss nil)
(setvar "cmdecho" cmd)
);;defun

;;-----------------------------------------------------------------------
(defun cpl(sla / cmd ss len i entname)
(gc)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ss (ssget "x" (list (cons -4 "(cons -4 "")
(cons -4 "")
(cons -4 "or>"))))
(if (/= ss nil)
(progn
(setq len (sslength ss))
(setq i 0)
(while (< i len)
(setq entname (ssname ss i))
(command "explode" entname)
(princ "\r")(princ "explode lwpolyline No:")(princ (+ i 1))
(setq i (+ i 1))
)
)
)
(setvar "cmdecho" cmd)
(setq ss nil)
(princ)
)
;;copy a entaty===========================================================================
(defun c:cop()
(gc)
(setq ent(entsel "\n Select a object:"))
(command "copy" ent "" (list 0 0) (list 0 0))
(command "change" "L" "" "p" "la" "0" "")
(princ)
)
;;lwpolyline edit=========================================================================
(defun c:EPL()
(gc)
(setq entname(entsel "\n Select a LWPOLYLINE:"))
(setq ent (entget (car entname)))
(setq m70 (cdr (assoc 70 ent)))
(setq m90 (cdr (assoc 90 ent)))
(if(> m90 1)(setq m90(- m90 1)))
(if(and (>= m90 1)(/= m70 129)(/= m70 1)(/= (assoc 70 ent) nil))(setq ent(subst (cons 90 m90) (assoc 90 ent) ent)))
(entmod ent)
(if(and (/= m70 129)(/= m70 1)(/= (assoc 70 ent) nil))(setq ent(subst (cons 70 1) (assoc 70 ent) ent)))
(if(= (assoc 70 ent) nil)(setq ent (append '((70 . 1)) ent)))
(entmod ent)
)
;;=========================================================================================
(defun C:XLIST()
(gc)
(while
(not (setq esel (entsel "\n Select a Entity:")))
)
(setq ename (car esel))
(redraw ename 3)
(setq rname (xstrcase (getstring "\nEnter application name <*>: ")))
(if (= rname "")(setq rname "*"))
(setq elist (entget ename (list rname)));;show elist.
(princ "\n************************ all dxf code ****************************************")
(princ "\n")
(princ elist)
(if (not (setq xd_list (assoc -3 elist)))
(progn
(princ "\n ++++++++++ No Xdata associated with Application Name(s).+++++++")
)
(setq xd_list (cdr xd_list))
)
(princ "\n\n******************************************************************************")
;;------------ Print XDATA ---------------------------------------------------------

-------
(redraw ename 4)
(setq linecount 0)
(while xd_list
(setq app_list (car xd_list))
(textscr)
(princ "\n* Registered Application Name: ")
(princ (car app_list))
(setq app_list (cdr app_list))
(while app_list
(setq app_sub_list (car app_list))
(setq xd_code (car app_sub_list))
(setq xd_data (cdr app_sub_list))
(cond
((= 1000 xd_code);;扩展数据中的ASCII字符串(最长255个字节)
(princ "\n* Code 1000, ASCII string: ")
(princ xd_data)
)
((= 1001 xd_code);;扩展数据中的已注册的应用程序名(ASCII字符串,最长31个字节)
(princ "\n* Code 1001, Registered application name: ")
(princ xd_data)
)
((= 1002 xd_code);;扩展数据中的控制字符串( "{" 或 "}" )
(princ "\n* Code 1002, Starting or ending brace: ")
(princ xd_data)
)
((= 1003 xd_code);;扩展数据图层名
(princ "\n* Code 1003, Layer name: ")
(princ xd_data)
)
((= 1004 xd_code);;扩展数据中的字节数组(最长127个字节)
(princ "\n* Code 1004, Binary data not printed.")
)
((= 1005 xd_code);;扩展数据中的图元句柄.文字字符串(最多16位十六进制数字)
(princ "\n* Code 1005, Database handle: ")
(princ xd_data)
)
((= 1010 xd_code);;扩展数据中的点,DXF中的X坐标(其后跟组码1020和1030)
(princ "\n* Code 1010, 3 real numbers: ")
(princ (strcat "("
(rtos (car xd_data)) " "
(rtos (cadr xd_data)) " "
(rtos (caddr xd_data)) ")"))
)
((= 1011 xd_code);;扩展数据中的三维世界空间位置,DXF中的X坐标(其后跟组码1021和1031)
(princ "\n* Code 1011, 3D World space position: ")
(princ (strcat "("
(rtos (car xd_data)) " "
(rtos (cadr xd_data)) " "
(rtos (caddr xd_data)) ")"))
)
((= 1012 xd_code);;扩展数据中的三维世界空间位移,DXF中的X坐标(其后跟组码1022和1032)
(princ "\n* Code 1012, 3D World space displacement: ")
(princ (strcat "("
(rtos (car xd_data)) " "
(rtos (cadr xd_data)) " "
(rtos (caddr xd_data)) ")"))
)
((= 1013 xd_code);;扩展数据中的三维世界空间方向,DXF中的X坐标(其后跟组码1023和1033)
(princ "\n* Code 1013, 3D World space direction: ")
(princ (strcat "("
(rtos (car xd_data)) " "
(rtos (cadr xd_data)) " "
(rtos (caddr xd_data)) ")"))
)
((= 1040 xd_code);;扩展数据浮点值
(princ "\n* Code 1040, Real number: ")
(princ (rtos xd_data))
)

((= 1041 xd_code);;扩展数据距离值
(princ "\n* Code 1041, Distance: ")
(princ (rtos xd_data))
)
((= 1042 xd_code);;扩展数据比例因子
(princ "\n* Code 1042, Scale factor: ")
(princ (rtos xd_data))
)
((= 1070 xd_code);;扩展数据16位符号整数
(princ "\n* Code 1070, 16-bit integer: ")
(princ xd_data)
)
((= 1071 xd_code);;扩展数据32位符号整数
(princ "\n* Code 1071, 32-bit signed long integer: ")
(princ (rtos xd_data 2 0))
)
(t
(princ "\n* Unknown xdata code: ")
(princ xd_code)
(princ " *")
)
);;cond
(setq app_list (cdr app_list))
(setq linecount (1+ linecount))
(if (>= linecount 20)
(progn
(getstring "\n-More-")
(setq linecount 0)
)
)
);;end while
(setq xd_list (cdr xd_list))
);;end while
(princ "\n\n************************** end ***********************************************")
(princ)
)
;;=========================================================================================
(defun C:XDATA( / all elist ename new rname size_new xd_list xd_list1 xd_list2 xd_list3 xd_ent regflag hand xflag
size_old which)
(gc)
(setq regflag 0)
(while
(not (setq esel (entsel)))
)
(setq ename (car esel))
(redraw ename 3)
(setq elist (entget ename (list "*")))
(setq cont T)
(while cont
;(setq rname (xstrcase (getstring "\nEnter application name: ")))
(setq rname (getstring "\nEnter application name: "))
(if (/= rname "")(setq cont nil))
)

(redraw ename 4)
(if (regapp rname)
(progn
(princ "\n New application." )
(princ rname)
)
(progn
(princ "\n Application ")
(princ rname )
(princ " already registered.\n")
)
)
;(setq xd_list (list '(1002 . "}"))) ; Initialize list of xdata for this app.
(setq xd_list (list)) ; Initialize list of xdata for this app.
(setq xd_type T) ; Initialize loop terminator.
(setq xflag 0)
(while (not (or (eq xd_type "EXit") (eq xd_type "Xit") (eq xd_type nil)))
(setq hand (getvar "handles"))
(initget
"STring LAyer 3Real Position DISPlacement Handle DIRection Real DISTance SCale Integer LOng EXit Xit _STring LAyer 3Real Position DISPlacement Handle DIRection Real DISTance SCale Integer LOng EXit Xit"
)
(setq xd_type (getkword
"\nEnter an option [3Real/DIR/DISP/DIST/Hand/Int/LAyer/LOng/Pos/Real/SCale/STr/eXit] : ")
)

(cond
((eq xd_type "3Real")
(if (/= (setq input (getpoint "\nSpecify 3 real numbers: ")) nil)
(setq xd_list (cons (cons 1010 input) xd_list))
)
)
((eq xd_type "DIRection")

(if (/= (setq input (getpoint "\nSpecify 3D World space direction: ")) nil)
(setq xd_list (cons (cons 1013 input) xd_list))
)
)
((eq xd_type "DISPlacement")
(if (/= (setq input (getpoint "\nSpecify 3D World space displacement: ")) nil)
(setq xd_list (cons (cons 1012 input) xd_list))
)
)
((eq xd_type "DISTance")
(if (/= (setq input (getdist "\nSpecify distance: ")) nil)
(setq xd_list (cons (cons 1041 input) xd_list))
)
)
((eq xd_type "Handle")
(if (or ( = (setq hand (getstring "\nEnter database handle: ")) "0")
(handent hand)
)
(setq xd_list (cons (cons 1005 hand) xd_list))
(if (/= hand "")
(princ "\nInvalid handle - handle must exist or have a 0 value.")
)
)
)

((eq xd_type "Integer")
(initget 4)
(if (/= (setq input (getint "\nEnter 16-bit integer: ")) nil)
(setq xd_list (cons (cons 1070 input) xd_list))
)
)
((eq xd_type "LAyer")
(setq input (getstring "\nEnter layer name: "))
(if (tblsearch "layer" input)
(setq xd_list (cons (cons 1003 input) xd_list))
(if (/= input "")
(princ "\nInvalid layer name - layer must exist.")
)
)
)
((eq xd_type "LOng")
(if (/= (setq input (getint "\nEnter 32-bit signed long integer: ")) nil)
(setq xd_list (cons (cons 1071 input) xd_list))
)
)
((eq xd_type "Position")
(if (/= (setq input (getpoint "\nSpecify 3D World space position: ")) nil)
(setq xd_list (cons (cons 1011 input) xd_list))
)
)
((eq xd_type "Real")
(if (/= (setq input (getreal "\nEnter real number: ")) nil)
(setq xd_list (cons (cons 1040 input) xd_list))
)
)
((eq xd_type "SCale")
(if (/= (setq input (getreal "\nEnter scale factor: ")) nil)
(setq xd_list (cons (cons 1042 input) xd_list))
)
)
((eq xd_type "STring")
(setq xd_list (cons (cons 1000 (getstring T
"\nEnter ASCII string: ")) xd_list))
)
(t)
);;cond
);;while

(setq xflag (length xd_list))
;(setq xd_list (cons '(1002 . "{") xd_list))
(setq xd_list (cons rname xd_list))
(setq xd_list (list -3 xd_list))
(setq size_new (xdsize xd_list))

(if (< size_new (xdroom ename))
(progn
(if (assoc -3 elist)
(progn
(setq xd_list (cdr xd_list)) ; New xdata.
(princ "\n XD_LIST==>")(princ xd_list)
(setq xd_ent (cdr (assoc -3 elist))) ; Old xdata.
(princ "\n XD_ENT==>")(princ xd_ent)
(if (setq old (cdr (assoc rname xd_ent)))

(progn
(setq regflag 1)
(setq new (reverse (cdr (assoc rname xd_list))))
(setq all (append new old)) ; Join old and new xdata with
;(setq xd_list1 (cons (cons 1002 "{") all)) ; Add open curly
(setq xd_list1 all) ; Add open curly
(setq xd_list2 (cons rname xd_list1)) ; Add regapp
(setq xd_list3 (subst xd_list2 (assoc rname xd_ent)(assoc -3 elist)))
)
(progn
(setq xd_list (append xd_ent xd_list)) ; Joins xdata.
(setq xd_list3 (cons -3 xd_list))
)
)
(setq elist (subst xd_list3 (assoc -3 elist) elist)) ; Joins entity
)
(setq elist (cons xd_list elist)) ; No xdata yet.
)
)
(princ "\n Insufficient Xdata space available on object- no new Xdata appended.")
);;if
(if (entmod elist)
(if (and (= 1 regflag) (<= xflag 1))
(princ "\nNo xdata appended.")
(princ "\nNew xdata appended.")
)
)
(redraw ename 4)
(princ)
)
;;====================================================================================
(defun C:chkGM()
(gc)
(if (/= (tblsearch "layer" "Building") nil)(gm "Building"))
(if (/= (tblsearch "layer" "Simple_building") nil)(gm "Simple_building"))
(if (/= (tblsearch "layer" "Shed") nil)(gm "Shed"))
(if (/= (tblsearch "layer" "Suspended_building") nil)(gm "Suspended_building"))
(if (/= (tblsearch "layer" "Pool_flatroof") nil)(gm "pool_flatroof"))
(if (/= (tblsearch "layer" "Basement_entrance") nil)(gm "Basement_entrance"))
(if (/= (tblsearch "layer" "Basement") nil)(gm "Basement"))
(if (/= (tblsearch "layer" "Land_classification") nil)(gm "Land_classification"))
(if (/= (tblsearch "layer" "River") nil)(gm "River"))
(if (/= (tblsearch "layer" "Mail_Area") nil)(gm "Mail_Area"))
(if (/= (tblsearch "layer" "Adminitrative_area") nil)(gm "Adminitrative_area"))
(if (/= (tblsearch "layer" "Block") nil)(gm "Block"))
(if (/= (tblsearch "layer" "Range") nil)(gm "Range"))
(if (/= (tblsearch "layer" "Mail_Area") nil)(gm "Mail_Area"))

)
(defun gm( gm_layer / ss len i entname ent m70 j )
(gc)
(setq ss (ssget "x"(list (cons -4 ""))))
(if (/= ss nil)
(progn
(setq len (sslength ss))
(setq i 0)
(setq j 1)
(while (< i len)
(setq entname (ssname ss i))
(setq ent (entget entname))
(setq m70 (cdr (assoc 70 ent)))
(if(and (/= m70 129)(/= m70 1)(/= (assoc 70 ent) nil))
(progn
(command "change" entname "" "P" "C" "6" "")
(redraw entname 3)
(setq j (+ j 1))
)
)
(if(= (assoc 70 ent) nil)
(progn
(command "change" entname "" "P" "C" "6" "")

(redraw entname 3)
(setq j (+ j 1))
)
)
(setq i (+ i 1))
)
(princ "\n***** ")(princ gm_layer)(princ "==>No cross lwpolyline: ")(princ j)(princ " *****")
)
)
(setq ss nil)
)
;;========================================================================================
(defun c:chksx(/ ss len i entname elist j south_list smi_list south_list_code south_list_KID
smi_list_data smi_list_int_structure smi_list_int_function smi_list_int_story
smi_list_int_hight smi_list_char_name smi_list_char_owner ename_layer ename_name
)
;;SOUTH房屋信息:
;;1000 ASCII string Code编码
;;1071 32bit integer KID值
;;smi房屋信息:
;;1070 16bit integer structure房屋结构
;;1070 16bit integer function 房屋用途
;;1070 16bit integer story 房屋层数
;;1070 16bit integer hight 房屋高度
;;1000 ASCII string name 单位名称
;;1000 ASCII string owner 房屋属主
;;1000 ASCII string source 房屋原始资料(04年新增)
;;1000 ASCII string toponym 地址 (04年新增)
(gc)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\n\n********无属性实体检查:********")
(setq ss(ssget "X"))
(if (/= ss nil)
(progn
(setq len (sslength ss))
(setq i 0)
(setq j 1)
(while (< i len)
(setq entname (ssname ss i))
(setq elist (entget entname (list "*")))
(setq ename_layer(cdr(assoc 8 elist)))
(setq ename_name(cdr(assoc 0 elist)))
(setq f3 (cdr (assoc -3 elist)))
(if(/= f3 nil)(JH_SOUTH_smi f3))
(setq south_list v_south_list)
(setq smi_list v_smi_list)
(setq south_list_code(cdr(car(cdr south_list))))
(setq south_list_KID(cdr(car(cddr south_list))))
(setq smi_list_data(cdr smi_list))
(if(/= smi_list_data nil)
(setq smi_list_int_structure(cdr (nth 0 smi_list_data)) ;;/=-1
smi_list_int_function(cdr (nth 1 smi_list_data)) ;;/=-1
smi_list_int_story(cdr (nth 2 smi_list_data)) ;;/=-1
smi_list_int_hight(cdr (nth 3 smi_list_data))
smi_list_char_name(cdr (nth 4 smi_list_data))
smi_list_char_owner(cdr (nth 5 smi_list_data))
smi_list_char_source(cdr (nth 6 smi_list_data))
smi_list_char_toponym(cdr (nth 7 smi_list_data))
)
)


(if(= f3 nil)
(progn
;(if(= (tblsearch "layer" "ERROR_SX") nil)(command "layer" "m" "ERROR_SX" "C" "6" "ERROR_SX" ""))
;(command "change" entname "" "P" "LA" "ERROR_SX" "")
(if(and(/= ename_name "TEXT")(/= ename_name "INSERT"))
(progn
(command "change" entname "" "P" "C" "6" "")
(princ "\n [")(princ j)(princ "] Layer=")(princ ename_layer)(princ " Entname=")(princ ename_name)
(redraw entname 3)
(setq j (+ j 1))
)
)
)

)

(if(/= f3 nil)
(progn
(if(and(= ename_layer "BUILDING")(or(= ename_name "LWPOLYLINE")(= ename_name "LINE")))
(progn
(if(or(= south_list nil)(= smi_list nil))
(progn
(command "change" entname "" "P" "C" "6" "")
(princ "\n [")(princ j)(princ "] Layer=")(princ ename_layer)(princ " Entname=")(princ ename_name)
(redraw entname 3)
(setq j (+ j 1))
)
);;if(or(= south_list nil)(= smi_list nil))

(if(and(/= south_list nil)(or (= south_list_code nil)(= south_list_code "")))
(progn
(command "change" entname "" "P" "C" "6" "")
(princ "\n [")(princ j)(princ "] Layer=")(princ ename_layer)(princ " Entname=")(princ ename_name)
(redraw entname 3)
(setq j (+ j 1))
)
)

(if(and(/= smi_list nil)(or (= smi_list_int_structure -1)(= smi_list_int_function -1)(= smi_list_int_story -1)))
(progn
(command "change" entname "" "P" "C" "6" "")
(princ "\n [")(princ j)(princ "] Layer=")(princ ename_layer)(princ " Entname=")(princ ename_name)
(redraw entname 3)
(setq j (+ j 1))
)
)
)
);;if(= ename_layer "BUILDING")

(if(and(= ename_layer "89")(= ename_name "TEXT")(= south_list nil))
(progn
(command "change" entname "" "P" "C" "6" "")
(princ "\n [")(princ j)(princ "] Layer=")(princ ename_layer)(princ " Entname=")(princ ename_name)
(redraw entname 3)
(setq j (+ j 1))
)
)

(if(and(= ename_name "INSERT")(= south_list nil))
(progn
(command "change" entname "" "P" "C" "6" "")
(princ "\n [")(princ j)(princ "] Layer=")(princ ename_layer)(princ " Entname=")(princ ename_name)
(redraw entname 3)
(setq j (+ j 1))
)
)
;;---
)
);;if(/= f3 nil)
(setq i (+ i 1))
);;while
(setq j (- j 1))
(princ "\n***** ")(princ "查出无属性实体: ")(princ j)(princ " 个.*****")
)
)
(setq ss nil)
(princ)
(setvar "cmdecho" cmd)
);;end
;;=================================================================================================
(defun c:addf1( / sx_layer ss len i k entname elist j south_list smi_list south_list_1000
smi_list_data smi_list_int_structure smi_list_int_function smi_list_int_story
smi_list_int_hight smi_list_char_name smi_list_char_owner tmp smi_new_list new_f3
f3 nth0 nth1 nth2 nth3 nth4 nth5)
(gc)
(setq sx_layer "BUILDING")
(setq ss (ssget "x"(list (cons -4 ""))))
(if (/= ss nil)
(pr

ogn
(setq len (sslength ss))
(setq i 0)
(setq j 1)
(setq k 0)
(while (< i len)
(setq k 0)
(setq entname (ssname ss i))
(setq elist (entget entname (list "*")))
(setq f3 (cdr (assoc -3 elist)))
(setq south_list(car f3))
(setq smi_list(car(cdr f3)))
(if(and(/= south_list nil)(/= smi_list nil))
(progn
(setq south_name(car south_list))
(if(= south_name "smi")
(progn
(setq tmp south_list)
(setq south_list smi_list)
(setq smi_list tmp)
)
)
(setq smi_list_data(cdr smi_list))
(setq smi_list_int_structure(cdr (nth 0 smi_list_data)));;/=-1
(setq smi_list_int_function(cdr (nth 1 smi_list_data))) ;;/=-1
(setq smi_list_int_story(cdr (nth 2 smi_list_data))) ;;/=-1
(setq smi_list_int_hight(cdr (nth 3 smi_list_data)))
(setq smi_list_char_name(cdr (nth 4 smi_list_data)))
(setq smi_list_char_owner(cdr (nth 5 smi_list_data)))

(if(or(= smi_list_char_name "")(= smi_list_char_name nil))
(progn
(setq smi_list_char_name "-1")
(redraw entname 3)
(if(= k 0)(setq j (+ j 1)))
(setq k (+ k 1))
)
)
(if(or(= smi_list_char_owner "")(= smi_list_char_owner nil))
(progn
(setq smi_list_char_owner "-1")
(redraw entname 3)
(if(= k 0)(setq j (+ j 1)))
(setq k (+ k 1))
)
)
(if(or(= smi_list_char_name "-1")(= smi_list_char_owner "-1"))
(progn
(setq nth0(cons 1070 smi_list_int_structure))
(setq nth1(cons 1070 smi_list_int_function))
(setq nth2(cons 1070 smi_list_int_story))
(setq nth3(cons 1070 smi_list_int_hight))
(setq nth4(cons 1000 smi_list_char_name))
(setq nth5(cons 1000 smi_list_char_owner))
(setq smi_new_list(list "smi" nth0 nth1 nth2 nth3 nth4 nth5))
(setq new_f3(list -3 south_list smi_new_list))
(setq elist (subst new_f3 (assoc -3 elist) elist))
(entmod elist)

)
)
)
)

(setq i (+ i 1))
)
(setq j (- j 1))
(princ "\n***** ")(princ sx_layer)(princ "==>XDATA add -1 code lwpolyline: ")(princ j)(princ " *****")
)
)
(setq ss nil)
)
;;=================================================================================================
(defun c:3dp()
(gc)
(command "regenauto" "off")
(setq cl(getfiled "Select A file" "" "*" 2))
(setq 23d(getstring "\n Select 2d,3d:[2 or 3]"))
(setq f(open cl "r"))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (null (tblsearch "layer" "Control_point")) (command ".layer" "make" "Control_point" "C" "1" "Control_point" "")(princ))
(if (null (tblsearch "layer" "Zdh")) (command ".layer" "make" "Zdh" "C" "1" "Zdh" "")(princ))
(setq i

1)
(while (/= (setq data(read-line f)) nil)
(setq len (strlen data))
(setq jsq_1 1)
(while(<= jsq_1 len)
(setq data_bt(substr data jsq_1 1))
(if(/= data_bt " ")
(progn
(setq jsq jsq_1)
(setq jsq_1 len)
)
);;if
(setq jsq_1 (+ jsq_1 1))
);;while
(setq data_wr "")
(while(<= jsq len)
(setq data_bt(substr data jsq 1))
(if(/= data_bt " ")
(setq data_wr(strcat data_wr data_bt))
(setq jsq len)
);;if
(setq jsq(+ jsq 1))
);;while
(setq pointname data_wr)
(setq data_b(strcat "(" data ")"))
(setq data_list(read data_b))
(setq y (nth 1 data_list))
(setq x (nth 2 data_list))
(if(= 23d "2")(setq z 0.0))
(if(= 23d "3")(setq z (nth 3 data_list)))
(if(= 23d "")(setq z (nth 3 data_list)))
(command "layer" "s" "control_point" "")
(command "insert" "szs" (list x y z) "" "" "")
(command "layer" "s" "Zdh" "")
(command "text" "s" "standard" (list x y z) 0.6 0 pointname )
(princ "\rNO: ")(princ (+ i 1))
(setq i(+ i 1))
);;while
(close f)
(command "zoom" "e")
(addpointsx)
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
);;end_defun
;;=================================================================================================
(defun c:Pointsx()
(gc)
(if (null (tblsearch "layer" "Control_point")) (command ".layer" "make" "Control_point" "C" "1" "Control_point" "")(princ))
(if (null (tblsearch "layer" "Zdh")) (command ".layer" "make" "Zdh" "C" "1" "Zdh" "")(princ))
(if (/= (tblsearch "layer" "500") nil)
(progn
(setq ss(ssget "X" '((8 . "500")(2 . "SZS"))))
(if(/= ss nil)(command "change" ss "" "P" "la" "Control_point" ""))
(setq ss(ssget "X" '((8 . "500") (0 . "TEXT"))))
(if(/= ss nil)(command "change" ss "" "P" "la" "Zdh" ""))
)
)
(addPointsx)
)

(defun addPointsx(/ sx_layer ss len i entname elist f3 new_f3 xd_139002_list new_f3_1 pointnum_list_name
pointnum_list ename_pt ename_layer osm cmd)
(gc)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq sx_layer "Control_point")
(setq ss (ssget "x"(list (cons 2 "SZS")(cons 8 sx_layer))))
(if (/= ss nil)
(progn
(setq len (sslength ss))
(setq i 0)
(setq j 1)
(while (< i len)
(setq entname (ssname ss i))
(setq elist (entget entname (list "*")))
(setq ename_layer(cdr(assoc 8 elist)))
(setq ename_pt(cdr(assoc 10 elist)))
(setq f3 (cdr (assoc -3 elist)))
(if(/= f3 nil)
(progn
(setq pointnum_list(car f3))
(setq pointnum_list_name(car pointnum_list))
(setq pointnum_list_name(strcase pointnum_list_name T))
(if(= pointnum_list_name "pointnum")
(progn

(command "layer" "s" ename_layer "")
(command "insert" "szs" ename_pt "" "" 0.0 )
(command "erase" entname "")
)
)
(setq j(+ j 1))
)
)
(setq i (+ i 1))
)
(setq j (- j 1))
(princ "\n***** ")(princ sx_layer)(princ "==>error code: ")(princ j)(princ " *****")
)
)

(setq ss (ssget "x"(list (cons 2 "SZS")(cons 8 sx_layer))))
(if (/= ss nil)
(progn
(setq len (sslength ss))
(setq i 0)
(setq j 1)
(while (< i len)
(setq entname (ssname ss i))
(setq elist (entget entname (list "*")))
(setq f3 (cdr (assoc -3 elist)))
(if(= f3 nil)
(progn
(regapp "SOUTH")
(setq xd_139002_list(cons 1000 "139002"))
(setq new_f3_1(list "SOUTH" xd_139002_list))
(setq new_f3(list(list -3 new_f3_1)))
(setq elist (append elist new_f3))
(setq j(+ j 1))
(entmod elist)
(entupd entname)
)
)
(setq i (+ i 1))
)
(setq j (- j 1))
(princ "\n***** ")(princ sx_layer)(princ "==>XDATA add 1000 code Block(SZS): ")(princ j)(princ " *****")
)
)
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(setq ss nil)
)
;;=================================================================================================
(defun c:npp( / ss len i j entname elist south_list smi_list ename_layer ename_name sxname
smi_list_data smi_list_int_structure smi_list_int_function smi_list_int_story
smi_list_int_hight smi_list_char_name smi_list_char_owner smi_list_char_source
smi_list_char_toponym tmp smi_new_list new_f3 f3 nth0 nth1 nth2 nth3 nth4 nth5 nth6 nth7)
;;SOUTH房屋信息:
;;1000 ASCII string Code编码
;;1071 32bit integer KID值
;;smi房屋信息:
;;1070 16bit integer structure房屋结构
;;1070 16bit integer function 房屋用途
;;1070 16bit integer story 房屋层数
;;1070 16bit integer hight 房屋高度
;;1000 ASCII string name 单位名称
;;1000 ASCII string owner 房屋属主
;;1000 ASCII string source 房屋原始资料(04年新增)
;;1000 ASCII string toponym 地址 (04年新增)
(gc)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "change" "all" "" "p" "c" "bylayer" "")
(setq ss (ssget "X" '((8 . "BUILDING")(0 . "LWPOLYLINE"))))
(if(/= ss nil)
(progn
(setq len (sslength ss))
(setq i 0)
(setq j 1)
(while (< i len)
(setq entname (ssname ss i))
(setq elist (entget entname (list "*")))
(setq ename_layer(cdr(assoc 8 elist)))
(setq ename_name(cdr(assoc 0 elist)))
(setq f3 (cdr (assoc -3 elist)))
(if(and (= ename_layer "BUILDING")(= ename_name "LWPOLYLINE")(/= f3 nil))

(progn
(setq south_list(car f3))
(setq smi_list(car(cdr f3)))
(if(and(/= south_list nil)(/= smi_list nil))
(progn
(setq south_name(car south_list))
(if(= south_name "smi")
(progn
(setq tmp south_list)
(setq south_list smi_list)
(setq smi_list tmp)
)
)
(setq smi_list_data(cdr smi_list))
(setq smi_list_char_name(cdr (nth 4 smi_list_data)))
)
)

)
)
(if(or(= smi_list_char_name "-1")(= smi_list_char_name nil)(= smi_list_char_name "")(= smi_list_char_name " ")(= south_list nil)(= smi_list nil))
(progn
(princ "\n <")(princ j)
(princ ">: https://www.sodocs.net/doc/841077396.html,=[ ")(princ smi_list_char_name)(princ "]")
(command "change" entname "" "p" "c" "11" "")
(setq j (+ j 1))
)
)
(setq i (+ i 1))
)
(setq j (- j 1))
(princ "\n\n ================= end ===============")
(princ "\n\n***** 一共有: ")(princ j)(princ " 个房屋无名称 *****")
)
)

(setq esel nil)
(setq ename nil)
(setq ename_layer nil)
(setq ename_name nil)
(setq f3 nil)
(setq south_list nil)
(setq smi_list nil)
(setq elist nil)
(setq smi_list_char_name nil)
(while
(not (setq esel (entsel "\n Select a Entity with name or a text:")))
)
(setq sxname nil)
(setq ename (car esel))
(redraw ename 3)
(setq elist (entget ename (list "*")))
(setq ename_layer(cdr(assoc 8 elist)))
(setq ename_name(cdr(assoc 0 elist)))
(setq f3(assoc -3 elist))
(if(= ename_name "TEXT")(setq sxname(cdr(assoc 1 elist))))
(if(and (= ename_layer "BUILDING")(= ename_name "LWPOLYLINE")(/= f3 nil))
(progn
(setq xd_list (cdr f3))
(setq south_list(car xd_list))
(setq smi_list(car(cdr xd_list)))
(if(and(/= south_list nil)(/= smi_list nil))
(progn
(setq south_name(car south_list))
(if(= south_name "smi")
(progn
(setq tmp south_list)
(setq south_list smi_list)
(setq smi_list tmp)
)
)
(setq smi_list_data(cdr smi_list)) ;; 读取smi房屋信息:
(setq smi_list_int_structure(cdr (nth 0 smi_list_data))) ;;1070 16bit integer 房屋结构
(setq smi_list_int_function(cdr (nth 1 smi_list_data))) ;;1070 16bit integer 房屋用途
(setq smi_list_int_story(cdr (nth 2 smi_list_data))) ;;1070 16bit integer 房屋层数
(setq smi_list_int_hight(cdr (nth 3 smi_list_data))) ;;1070 16bit integer 房屋高度
(setq smi_list_char_name(cdr (nth 4 smi_list_data))) ;;;;;;;;;1000 ASCII string 单位名称
(setq smi_list_char_owner(cdr (nth 5 smi_list_data))) ;;1000 ASCII string 房屋属主
(setq smi_list_char_source(cdr (nth 6 smi_list_data))) ;;1000 ASCII string 房屋原始资料(04年新增)
(setq smi_list_char_toponym(cdr (nth

7 smi_list_data))) ;;1000 ASCII string 地址 (04年新增)
(setq sxname smi_list_char_name)
(if(= sxname "")(setq sxname nil))
)
)
)
)
(if(and (/= sxname nil)(/= sxname "")(/= sxname "-1"))
(progn
(princ "\n\n https://www.sodocs.net/doc/841077396.html,===> ")
(princ sxname)
)
(princ "\n\n *****Error*****,https://www.sodocs.net/doc/841077396.html,=NILL or -1")
)
;;add https://www.sodocs.net/doc/841077396.html,
(setq esel nil)
(setq ename nil)
(setq ename_layer nil)
(setq ename_name nil)
(setq f3 nil)
(setq south_list nil)
(setq smi_list nil)
(setq elist nil)
(setq ss nil)
(if(and (/= sxname nil)(/= sxname "")(/= sxname "-1"))
(progn
(princ "\n\n Select entity to add https://www.sodocs.net/doc/841077396.html,")
(setq ss (ssget))
(if(/= ss nil)
(progn
(setq len (sslength ss))
(setq i 0)
(setq j 1)
(princ "\n\n ================= add https://www.sodocs.net/doc/841077396.html,===============")
(while (< i len)
(setq entname (ssname ss i))
(setq elist (entget entname (list "*")))
(setq ename_layer(cdr(assoc 8 elist)))
(setq ename_name(cdr(assoc 0 elist)))
(setq f3 (cdr (assoc -3 elist)))
(if(and (= ename_layer "BUILDING")(= ename_name "LWPOLYLINE")(/= f3 nil))
(progn
(setq south_list(car f3))
(setq smi_list(car(cdr f3)))
(if(and(/= south_list nil)(/= smi_list nil))
(progn
(setq south_name(car south_list))
(if(= south_name "smi")
(progn
(setq tmp south_list)
(setq south_list smi_list)
(setq smi_list tmp)
)
)
(setq smi_list_data(cdr smi_list))
(setq smi_list_int_structure(cdr (nth 0 smi_list_data)))
(setq smi_list_int_function(cdr (nth 1 smi_list_data)))
(setq smi_list_int_story(cdr (nth 2 smi_list_data)))
(setq smi_list_int_hight(cdr (nth 3 smi_list_data)))
(setq smi_list_char_name(cdr (nth 4 smi_list_data)))
(setq smi_list_char_owner(cdr (nth 5 smi_list_data)))
(setq smi_list_char_source(cdr (nth 6 smi_list_data)))
(setq smi_list_char_toponym(cdr (nth 7 smi_list_data)))
)
)
(princ "\n ")(princ j)
(princ ": Old https://www.sodocs.net/doc/841077396.html,=[ ")(princ smi_list_char_name)
(princ " ] New https://www.sodocs.net/doc/841077396.html,=[ ")(princ sxname)(princ " ]")
(setq smi_list_char_name sxname)
(if(/= smi_list_int_structure nil)(setq nth0(cons 1070 smi_list_int_structure))(setq nth0(cons 1070 0)))
(if(/= smi_list_int_function nil)(setq nth1(cons 1070 smi_list_int_function))(setq nth1(cons 1070 0)))
(if(/= smi_list_int_story nil)(setq nth2(cons 1070 smi_list_int_story))(setq nth2(cons 1070 -1)))
(if(/= smi_list_int_hight nil)(setq nth3(cons 1070 smi_list_int_hight))(setq nth3(cons 1070 -1)))
(if(/= smi_list_char_name nil)(setq nth4(cons 1000 smi_list_char_name))(setq nth4(cons 1000 "-1")))
(if(/= smi_list_char_owner nil)(setq nth5(cons 1000 smi_list_char_owner))(setq nth5(cons 1000 "-1")))