|
|
楼主 |
发表于 2018-10-29 19:06
|
显示全部楼层
(defun c:22()
(setq os(getvar "osmode"))
(setvar "osmode" 0)
(command "rotate")
(setvar "osmode" os)
)
(defun c:33()
(setq os(getvar "osmode"))
(setvar "osmode" 0)
(setq ss(ssget '((0 . "TEXT"))))
(setq n 0)
(repeat (sslength ss)
(setq ssn(ssname ss n))
(setq ssdata(entget ssn))
(setq crd(cdr(assoc 10 ssdata))
dqd(cdr(assoc 11 ssdata)))
(setq ssdata (subst (cons 73 3) (assoc 73 ssdata) ssdata))
(entmod ssdata)
(entupd ssn)
;;; (command "circle" crd 4)
;;; (command "circle" dqd 5)
(setq n(1+ n))
)
(setvar "osmode" os)
)
(defun c:9()
(command "dd" "164300"))
(defun c:11();旋转180度以文字中心
(setq os(getvar "osmode"))
(setvar "osmode" 0)
(setq ss(ssget '((0 . "TEXT"))))
(setq n 0)
(repeat (sslength ss)
(setq sn(ssname ss n))
(setq ssdata (entget sn ))
(setq jd (cdr(assoc 50 ssdata )))
(setq pt1 (cdr (assoc 10 ssdata)))
(setq pt2(cdr (assoc 11 ssdata)))
(setq szb(textbox ssdata))
;;; (command "circle" pt1 4)
;;; (command "circle" pt2 4)
(setq njd(+ jd 3.1415926))
(setq ssdata (subst (cons 50 njd) (assoc 50 ssdata) ssdata))
(entmod ssdata)
(entupd sn)
(setq n(1+ n))
)
(setvar "osmode" os)
)
(defun c:8()
(command "-boundary" ))
(defun c:7()
(command "matchprop"))
(defun c:6()
(setvar "cmdecho" 0)
(setq os(getvar "osmode"))
(setvar "osmode" 0)
(setq a(ssget '((2 . "GDDJTK2"))))
(if(= a nil)
(progn(alert "没有需要打印的宗地图！")(exit)))
(setq aa (sslength a))
(setq nu 0)
(repeat aa
(setq ac(entget(ssname a nu)))
(setq ac_data(assoc 10 ac))
(setq x_zb(car(cdr ac_data)))
(setq y_zb(cadr(cdr ac_data)))
(setq one(list(- x_zb 7)(- y_zb 20))
trhee(list(+ x_zb 98)(+ y_zb 128.5)))
(plot_bdy)
(setq nu(+ nu 1)))
(setvar "cmdecho" 1)(setvar "osmode" os)
(princ))
(defun plot_bdy()
;;; (command "-plot" "y")
(command "-plot" "y" "" "" "" "" "p" "" "w" one trhee "f" "C" "y" "" "y" "" "" "" "" ))
(PRINC "\n 程序加载成功，用pt启动自动打印功能")
(defun c:5();幢号
(setq i 1)
(repeat 6
(setq n(rtos i 2 0))
(setq pt1 (getpoint "选择起点\n" ))
(command "text" "j" "bc" pt1 "0" (strcat "(" n ")"))
(setq i(1+ i))))
(defun c:55();幢号批量
(setq n 0)
(setq tk(ssget "x" '((0 . "INSERT")(2 . "gddjtk2"))))
(setq tklen(sslength tk))
(repeat tklen
(setq tkname(ssname tk n))
(setq tkdata(entget tkname))
(setq tkzb(cdr(assoc 10 tkdata)))
(setq tkzbys(mapcar '+ tkzb '(36 31.6)))
(command "zoom" "w" tkzb tkzbys 200)
(setq n(1+ n))
(setq i 1)
(setq pt1 t)
(setq *error* errtmp)
(while pt1
(setq io(rtos i 2 0))
(setq pt1 (getpoint "选择起点\n" ))
(if pt1
(progn
(command "text" "j" "bc" pt1 "0" (strcat "(" io ")"))
(setq i(1+ i)))))
)
)
(defun c:1();边长注记
(setq os(getvar "osmode" ))
(setvar "osmode" 0)
(setq sskent(ssget '((0 . "lwpolyline"))))
(setq ssl(sslength sskent))
(setq i 0)
(command "style" "黑体" "simhei.ttf" "0.4" "1" "0" "n" "n" )
;;; (setq num (getint "请键入一个数字："))
(while (< i ssl )
(setq ssn(ssname sskent i))
(tqjl ssn )
(setq i(1+ i) ))
(setvar "osmode" os)
)
;;;)
;;;)
(princ)
;1if
(defun tqjl(ssn);提取距离
(setq n 0)
(setq y 0)
;;; (setq li10 nil)
(setq li1 nil li2 nil)
(setq li0 nil)
;;;(setq ssn(ssname ss i))
(setq ssdata(entget ssn))
(repeat (- (length ssdata) 1);提取多段线顶点列表
(setq tmp (car (nth n ssdata)))
(cond
((= tmp 10)(progn ;(setq li10(nth n ssdata))
(setq li1(cdr(nth n ssdata)))
(if (= li0 nil )
(setq li0 li1)
)
(if (/= li2 nil)
(progn
(setq sjl(rtos (distance li1 li2) 2 2))
(setq hd(angle li2 li1))
(if (and (> hd 1.5708 )(< hd 6.26))(setq hd( + hd 3.14159)))
;;; (if (and (> (- hd 1.5708)0)(< (- hd 3.14159)0)) (setq hd(+ hd 3.14159)))
(setq jd(angtos hd 0 4))
(setq zd(mapcar '/ (mapcar '+ li1 li2) '(2 2 2)))
(command "text" "j" "bc" zd jd sjl)
)
)
(setq li2(cdr(nth n ssdata)))
;;; (setq li10 (append (list (nth n ssdata)) li10)));找到顶点就添加进列表
;;; (setq s (strcat "pt" "," (rtos (nth 1 li10) 2 3) "," (rtos (nth 2 li10) 2 3))))
;;; (write-line s ff)
;;; (if (> n (- (length ssdata)3))
;;; (progn
;;; (setq sjl(rtos (* (distance li0 li1) 0.4) 2 2))
;;; (setq jd(angtos (angle li0 li1)0 4))
;;; (setq zd(mapcar '/ (mapcar '+ li0 li1) '(2 2 2)))
;;; (command "text" "j" "bc" zd "0" jd sjl)
;;; )
;;; )
(setq y (1+ y))
)))
(setq n (1+ n))
)
(if (AND (> y 2) (>= (cdr(ASSOC 70 SSDATA )) 128))
(progn
(setq sjl(rtos (distance li0 li1) 2 2))
(setq hd(angle li1 li0))
;;; (if (> (- hd 3.14159)0) (setq hd(+ hd 3.14159)))
(setq jd(angtos hd 0 4))
(setq zd(mapcar '/ (mapcar '+ li0 li1) '(2 2 2)))
(command "text" "j" "bc" zd jd sjl)
))
;;; (setq sjl1(cdr(car li10)))
;;; (setq sjl2(cdr(cadr li10)))
;;; (setq sjll(distance sjl1 sjl2))
;;; (setq i(1+ i))
)
(princ)
(defun c:2()
(setq os(getvar "osmode" ))
(setvar "osmode" 0)
(setq m 0)
(setq ssken(ssget '((0 . "lwpolyline"))))
(vl-load-com)
(repeat (sslength ssken)
(setq li0 nil li1 nil li2 nil li3 nil)
(setq x 1 n 0)
(setq ssnam(ssname ssken m))
(setq ssdata(entget ssnam))
(repeat (- (length ssdata) 1);提取多段线顶点列表
(setq tmp (car (nth n ssdata)))
(cond
((= tmp 10)(progn ;(setq li10(nth n ssdata))
(setq li1(cdr(nth n ssdata)))
(if (= li0 nil )
(setq li0 li1)
)
(if (= x 3)
(setq li3 li1))
;;; (if (/= li2 nil)
;;;;;; (progn
;;;;;; (setq sjl(rtos (distance li1 li2) 2 2))
;;;;;; (setq jd(angtos (angle li1 li2)0 4))
;;;;;; (setq zd(mapcar '/ (mapcar '+ li1 li2) '(2 2 2)))
;;;;;; (command "text" "j" "bc" zd "0" jd sjl)
;;;;;; )
;;;
;;; )
(setq li2(cdr(nth n ssdata)))
(setq x (1+ x))
)))
(setq n (1+ n))
)
;;; (setq sjl(rtos (distance li1 li2) 2 2))
;;; (setq jd(angtos (angle li0 li2)0 4))
(setq zd(mapcar '/ (mapcar '+ li0 li3) '(2 2 2)))
(setq ln (vlax-ename->vla-object ssnam))
(setq mj(rtos(vla-get-Area ln) 2 2))
(command "style" "黑体" "simhei.ttf" "0.6" "1" "0" "n" "n" )
(command "mtext" li0 "j" "mc" li3 mj "")
(setq m(1+ m))
)
(setvar "osmode" os)
)
(defun c:44();超占情况多行文字加和
;(setvar "cmdecho" 0)
(setq os(getvar "osmode"))
(setvar "osmode" 0)
(princ "\n选土地证记载范围内建筑面积,选择顺序：主房面积，合法偏房面积（小）")
(setq smtxt(ssget '((0 . "MTEXT")) ))
(if (/= smtxt nil)
(progn
(setq i 1)
(setq sum 0)
(setq nsum 0)
(setq sfirst(ssname smtxt 0))
(setq ssdata(entget sfirst))
(setq sswz(cdr(assoc 1 ssdata)));获取文字
(setq strzb(cdr(assoc 10 ssdata)));获取坐标在第一个多行文字附近搜房产图框
;;; (setq zsjzb(mapcar '+ strzb '(25 35)));左上角坐标
;;; (setq tk(ssget "c" zsjzb strzb '((0 . "INSERT")(2 . "gddjtk2"))))
;;; (setq tkname(ssname tk 0))
;;; (setq tkdata(entget tkname))
;;; (setq tkzb(cdr(assoc 10 tkdata)));图框左下角坐标
;;; (setq mjcrd(mapcar '+ tkzb '(32.02 3.73)));面积插入点
(repeat 20(setq sswz(vl-string-subst "" "{\\L" sswz)));主房面积
(repeat 20(setq sswz(vl-string-subst "" "}" sswz)));主房面积
(setq sswz(atof sswz ))
(setq nsum sswz)
(repeat (- (sslength smtxt) 1)
(setq sntxt(ssname smtxt i))
(setq sum(cdr(assoc 1 (entget sntxt))))
(repeat 10(setq sum(vl-string-subst "" "{\\L" sum)));合法偏房面积
(repeat 10(setq sum(vl-string-subst "" "}" sum)));合法偏房面积
(setq sum(atof sum ))
(setq nsum(+ nsum sum));合法建筑面积和
(setq i(1+ i)))
(princ "\n选取合实际建筑面积,选择顺序：原偏房面积（大）")
(setq shftxt(ssget '((0 . "MTEXT"))))
;;
(command "zoom" "c" strzb 100)
(setq zsjzb(mapcar '+ strzb '(25 35)));左上角坐标
(setq tk(ssget "c" zsjzb strzb '((0 . "INSERT")(2 . "gddjtk2"))))
(setq tkname(ssname tk 0))
(setq tkdata(entget tkname))
(setq tkzb(cdr(assoc 10 tkdata)));图框左下角坐标
(setq mjcrd(mapcar '+ tkzb '(32.02 3.73)));面积插入点
;;
(setq n 0)
(setq bhfmj 0);不合法偏房面积和
(if (/= shftxt nil)
(PROGN
(repeat (sslength shftxt)
(setq sbhfname(ssname shftxt n))
(setq sbhfdata(entget sbhfname))
(setq sbhfwz(cdr(assoc 1 sbhfdata)))
(repeat 20(setq sbhfwz(vl-string-subst "" "{\\L" sbhfwz)));不合法偏房面积
(repeat 20(setq sbhfwz(vl-string-subst "" "}" sbhfwz)));不合法偏房面积
(setq sbhfwz(atof sbhfwz ))
(setq bhfmj(+ bhfmj sbhfwz));不合法建筑面积和
(setq n(1+ n)))
))
(princ(setq nsum (rtos nsum 2 2)))
(setq bhfmj(+ sswz bhfmj))
(princ(setq bhfmj (rtos bhfmj 2 2)))
(setq nsum (strcat nsum "㎡"))
(setq bhfmj (strcat bhfmj "㎡"))
(setq strsj(strcat "实际建筑面积" bhfmj ))
(setq strcz(strcat "土地证记载范围内建筑面积" nsum ))
(setq sjzb(mapcar '+ tkzb '(0 0.9)));实际建筑面积插入点
(command "text" "s" "宋体" "j" "bl" mjcrd "0" nsum);合法面积和
(command "text" "s" "宋体" "j" "bl" sjzb "0" strsj);实际建筑面积
(command "text" "s" "宋体" "j" "bl" tkzb "0" strcz);土地证记载范围内建筑面积
)
)(setvar "osmode" os)
)
(defun c:4();选多行文字求和
;(setvar "cmdecho" 0)
(setq os(getvar "osmode"))
(setvar "osmode" 0)
(setq ss(ssget '((0 . "INSERT")(2 . "gddjtk2")) ))
(setq n 0)
(repeat (sslength ss)
(setq ssn(ssname ss n))
(setq ssdata(entget ssn))
(setq zxj(cdr(assoc 10 ssdata)))
(setq ysj(mapcar '+ zxj '(36 41.6)))
(setq crd(mapcar '+ zxj '(32.02 3.73)))
(command "zoom" "c" zxj 100)
;(command "CIRCLE" crd 400)
(setq smtxt(ssget "w" zxj ysj '((0 . "MTEXT"))))
(if (/= smtxt nil)
(progn
(setq i 0)
(setq nsum 0)
(setq sum 0)
(repeat (sslength smtxt)
(setq sntxt(ssname smtxt i))
(setq sum(cdr(assoc 1 (entget sntxt))))
(repeat 50
(setq sum(vl-string-subst "" "{\\L" sum))
)
(setq sum(vl-string-subst "" "}" sum))
(setq sum(atof sum ))
(setq nsum(+ nsum sum))
(setq i(1+ i))
)
(princ(setq nsumtext (rtos nsum 2 2)))
(setq nsumtext (strcat nsumtext "㎡"))
(command "text" "s" "宋体" "j" "bl" crd "0" nsumtext)
))
(setq n (1+ n))
)
;;;(setq ss(ssget ))
;;;(setq n 0)
;;;(repeat (sslength ss)
;;; (setq ssn(ssname ss n))
;;; (setq ssdata(entget ssn))
;;; (setq zxj(cdr(assoc 10 ssdata)))
;;;;;; (setq ysj(mapcar '+ zxj '(90 100)))
;;; (setq crd(mapcar '+ zxj '( 80.73 9.621)))
;;; (command "zoom" "c" zxj 300)
;(command "CIRCLE" crd 4)
;;; (setq smtxt(ssget '((0 . "MTEXT"))))
;;; (if (/= smtxt nil)
;;; (progn
;;;
;;; (setq i 0)
;;; (setq nsum 0)
;;; (setq sum 0)
;;; (setq sfirst(ssname smtxt 0))
;;; (setq ssdata(entget sfirst))
;;; (setq strzb(cdr(assoc 10 ssdata)));获取坐标在第一个多行文字附近搜房产图框
;;; (setq zsjzb(mapcar '+ strzb '(25 35)));左上角坐标
;;;;;; (command "CIRCLE" zsjzb 4)
;;;;;; (command "CIRCLE" strzb 4)
;;; (command "zoom" "c" strzb 50)
;;; (setq tk(ssget "c" zsjzb strzb '((0 . "INSERT")(2 . "gddjtk2"))))
;;; (setq tkname(ssname tk 0))
;;; (setq tkdata(entget tkname))
;;; (setq tkzb(cdr(assoc 10 tkdata)));图框左下角坐标
;;; (setq mjcrd(mapcar '+ tkzb '(32.02 3.73)));面积插入点
;;; ;(command "CIRCLE" mjcrd 4)
;;;
;;; (repeat (sslength smtxt)
;;; (setq sntxt(ssname smtxt i))
;;; (setq sum(cdr(assoc 1 (entget sntxt))))
;;; (repeat 50
;;; (setq sum(vl-string-subst "" "{\\L" sum))
;;;
;;; )
;;; (setq sum(vl-string-subst "" "}" sum))
;;; (setq sum(atof sum ))
;;; (setq nsum(+ nsum sum))
;;; (setq i(1+ i))
;;; )
;;;;;; (setq crd(getpoint "\n选择插入点"))
;;; (princ(setq nsumtext (rtos nsum 2 2)))
;;;(setq nsumtext (strcat nsumtext "㎡"))
;;; (command "text" "s" "宋体" "j" "bl" mjcrd "0" nsumtext)
;;; ))
;(setq n (1+ n))
(setvar "osmode" os)
)
(defun c:3()
(setq ss(ssget '((0 . "MTEXT"))))
(setq i 0)
(setq sslen(sslength ss))
(repeat sslen
(setq ssn(ssname ss i))
(setq ssdata(entget ssn))
(setq mjtxt(cdr(assoc 1 ssdata)))
(setq ssdata
(subst (cons 1 (strcat "{\\L" mjtxt "}"))
(assoc 1 ssdata)
ssdata))
(entmod ssdata)
(entupd ssn)
(setq i(1+ i))
))
(defun CenPoint(e / p x y m p1 p2 pt ang d dd) ;;;多边形近似中心，不能跑外边去哦
(setq x 0 y 0 pt(plinexy e)m(length pt))
(foreach p pt(setq x(+(car p)x)y(+(cadr p)y)))
(setq p(list(/ x m)(/ y m))y 0
p1(vlax-curve-getClosestPointTo(vlax-ename->vla-object e) p)p2 nil
d(distance p1 p)
dd(/ d 5.0)
ang(if(PoinPl p pt)(angle p1 p)(angle p p1))
d(if(PoinPl p pt)(+ d dd) dd))
(while(<(length p2)2)
(entmake (LIST(CONS 0 "line") (CONS 10 p1) (CONS 11(polar p ang d))))
(setq e1(vlax-ename->vla-object(entlast))
p3(vlax-variant-value(vla-IntersectWith(vlax-ename->vla-object e)e1 0))d(+ d dd))
(if(>(vlax-safearray-get-u-bound p3 1)1)
(progn
(setq p2 nil
p3(vlax-safearray->list p3)i 0)
(repeat(/(length p3)3)
(setq p2 (cons(list(nth i p3)(nth(+ 1 i)p3)(nth (+ 2 i)p3))p2)
i(+ 3 i))
)))
(vla-delete e1))
(setq p1(car p2)
p2(last p2)
p(list(/(+(car p1)(car p2))2)(/(+(cadr p1)(cadr p2))2)))
)
(defun plinexy(e / a q m p);;;LWPolyline,POLYLINE顶点,去掉完全重合点
(vl-load-com)
(setq a(vlax-ename->vla-object e)
q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
m(vla-get-objectname a)a 0
m(if(= m"AcDb3dPolyline")3 2))
(repeat(/(length q)m)
(cond((= m 2)(setq p1(list(nth a q)(nth(+ a 1)q))))
((= m 3)(setq p1(list(nth a q)(nth(+ a 1)q)(nth(+ a 2)q)))))
(setq p(if (member p1 p)p (append p(list p1)))
a(+ a m)))
p)
(defun PoInPl(P Pt / e1) ;;点在多边形内的另类判断
(entmake(list(cons 0 "TEXT")(cons 8 "0") (cons 62 254)(cons 10 p)(cons 40 0.000001)
(cons 1 "@.")(cons 7 "STANDARD") (cons 72 1)(cons 11 p)))
(setq e1(ssget"WP"pt'((0 . "TEXT")(8 . "0")(1 . "@.")(40 . 0.000001)))
e1(if e1(if(=(vl-princ-to-string(entlast))(vl-princ-to-string(ssname e1 0)))t)))
(entdel(entlast))
e1)
(defun HH:perPt (P p1 p2 / pt)
(setq pt (mapcar '+ (MAT:Rot90 (mapcar '- p1 p2)) p)) ;highflybir论矩阵
(inters p1 p2 p pt nil) ;垂点
)
;;;-----------------------------------------------------------;;
;;; 旋转一个向量或者点90度 ;;
;;; 输入: 一个向量 ;;
;;; 输出: 被旋转90度后的向量 ;;
;;;-----------------------------------------------------------;;
(defun MAT:Rot90 (vec)
(vl-list* (- (cadr vec)) (car vec) (cddr vec))
) |
|
楼主: tloveuz
雷达卡
发表于 2018-10-29 19:05
提升卡
沉默卡
喧嚣卡
变色卡
抢沙发
显身卡
.gif)
.gif)
