插件为什么07版能用，2020用不了啊
本帖最后由 jackAqwq 于 2022-8-8 10:18 编辑(defun c:ll () ;建立初始图形
(command "-layer" "m" "1" "c" "4" "" "")
(command "osmode" "147")
(command "line")
) ;_ 结束defun
(defun c:tbo () ;建立套内图形
(alert "请注意多义线的连接")
(command "-layer" "m" "套内线" "c" "7" "" "lt" "continuous" "" "") ;_ 结束command
(command "osmode"0 )
(command "bpoly")
) ;_ 结束defun
(defun c:ybo () ;建立阳台图形
(alert "请注意多义线的连接")
(command "-layer" "m" "阳台线" "c" "7" "" "lt" "hiddenx2" "" "") ;_ 结束command
(command "osmode" 0 )
(prompt"\n请在阳台草图中点取一点：")
(WHILE(SETQ D (GETPOINT))
(command "bpoly" D""))
) ;_ 结束defun
(defun c:ppu () ;清除无关对象
(alert "确认阳台与套内图形标明完毕？")
(command "-layer" "s" "0" "")
(command "-layer" "f" "套内线" "")
(command "-layer" "f" "阳台线" "")
(command "-layer" "f" "边长" "")
(command "-layer" "f" "面积" "")
(command "-layer" "f" "名称" "")
(command "erase" "all" "")
(command "purge" "a" "" "n")
(command "-layer" "t" "*" "")
) ;_ 结束defun
(defun c:DB () ;标注单边长度
(setvar "dimzin" 1)
(command "-layer" "m" "边长" "c" "3" "" "")
(command "style" "A" "txt.shx" ".4" "" "" "" "" "")
(command "osmode"1 )
(while
(setq ps (getpoint "\n 起点:") )
(IF(= ( NULL PS) T) "")
(setq pe (getpoint "终点:")
PSx(atof (rtos (car PS)))
PSy(atof (rtos (cadr PS)))
PEx (atof (rtos (car PE)))
PEy (atof (rtos (cadr PE)))
dwx (/ (+ PSx PEx) 2)
dwy (/ (+ PSy PEy) 2)
dw(list dwx dwy)
s (distance ps pe)
fse (angle ps pe)
fse (* fse 180.0)
fse (/ fse pi)
sc (rtos s 2 2))
(command "osmode"0 )
(command "text" "j" "bc" DW fse sc)
(command "osmode"1 ) ) ;_ 结束while
) ;_ 结束defun
(defun c:tt () ;标注名称
(command "style" "c" "txt,hztxt.shx" ".6" "" "" "" "" "")
(command "layer" "m" "名称" "c" "7" "" "")
(prompt "\n选择文字标注位置")
(while
(setq pnt (getpoint))
(setq a "梯")
(command "text" "j" "m" pnt "0" a)
) ;_ 结束while
) ;_ 结束defun
(defun c:af () ;房产处理
(command "zoom" "e")
(command "style""szfcch_textstyle""txt.shx,HZTXT.SHX""""""""""""") ;_ 结束command
(command "style" "szfcch_linestyle" "ROMANS" "" "" "" "" "" "") ;_ 结束command
(command "style" "szfcch_areastyle" "romantic" "" "" "" "" "" "") ;_ 结束command
(command "areatext" "")
(command "linetext" "")
(command "nametext" "")
(command "zoomtext")
) ;_ 结束defun
(defun c:da () ;标注顺序号
(command "osmode"1 )
(command "style" "D" "romans" "2.0" "" "" "" "" "")
(prompt "\n选择文字标注位置")
(setq i 1)
(while
(setq pnt (getpoint))
(command "text" pnt "0" i)
(setq i (+ 1 i))
(command "circle" pnt "0.28")
) ;_ 结束while
) ;_ 结束defun
(defun c:ZB () ;标注单点坐标
(command "style" "D" "txt.SHX" "1.0" "1" "" "" "" "")
(command "OSMODE" 1)
(while (setq a (getpoint)
ay (rtos (cadr A) 2 2)
ax (rtos (car A) 2 2)
ayx"x="
axy"y="
bx (strcat ayx ay)
by (strcat axy ax)
y (cadr A)
x (car A)
p (list (+ x 1) (+ y 1.5))
y2 (cadr p)
x2 (car p)
pp (list (+ x2 5) y2)
ppp(list (+ x2 0.15) (+ y2 0.3))
pppp (list (+ x2 0.15) (- y2 1.3))
) ;_ 结束setq
(command "OSMODE" 0)
(command "pline" A p pp "")
(command "circle" A "0.2")
(command "text" ppp "0" bx)
(command "text" pppp "0" by)
(command "OSMODE" 1)
) ;_ 结束WHILE
) ;_ 结束defun
(defun c:ZXZB () ;标注组线坐标
(command "style" "D" "txt.SHX" "1.5" "1" "" "" "" "")
(command "OSMODE" 0)
(setvar "dimzin" 1)
(setq s(ssget (list (cons 0 "LWPOLYLINE")))
n(sslength s)
ss (ssname s 0)
a1 (entget ss)
a4 (cdr (assoc 90. a1))
) ;_ 结束setq
(if (= (fix (atof (getvar "acadver"))) 14)
(setq gs 12)
(setq gs 14)
) ;_ 结束if
(repeat a4
(setq
a2 (nth gs a1)
a3 (cdr a2)
ay (rtos (cadr a3) 2 2)
ax (rtos (car a3) 2 2)
ayx"x="
axy"y="
bx (strcat ayx ay)
by (strcat axy ax)
p0 (list bx by)
p (list (+ (atoi ax) 1.5) (+ (atoi ay) 2))
y2 (cadr p)
x2 (car p)
pp (list (+ x2 5) y2)
ppp(list (+ x2 0.15) (+ y2 0.3))
pppp (list (+ x2 0.15) (- y2 1.8))
) ;_ 结束setq
(princ p0)
(command "line" a3 p pp "")
(command "circle" a3 "0.2")
(command "text" ppp "0" bx)
(command "text" pppp "0" by)
(setq gs (+ gs 4))
(princ)
) ;_ 结束repeat
) ;_ 结束defun
(defun c:mj () ;标注面积
(command "style" "romant" "romant.SHX" "0.336" "1.0" "" "" "" "") ;_ 结束command
(command "osmode" 0)
(setq s(ssget (list (cons 0 "LWPOLYLINE")))
n(sslength s)
i0
A0 0
) ;_ 结束setq
(setq ss (ssget "x"))
(command "change" ss "" "p" "c" "bylayer" "lt" "bylayer" "LTS" 1 "") ;_ 结束command
(command "-layer" "m" "面积" "c" "7" "" "")
(setvar "dimzin" 1)
(if (= (fix (atof (getvar "acadver"))) 14)
(setq gs 12)
(setq gs 14)
) ;_ 结束if
(repeat n
(setq obj (ssname s i)
a1 (entget obj)
a2 (nth gs a1)
a3 (cdr a2)
a3x (car a3)
a3y (cadr a3)
a22 (nth (+ 4 gs) a1)
a33 (cdr a22)
a33x(car a33)
a33y(cadr a33)
a222(nth (+ 8 gs) a1)
a333(cdr a222)
a333x (car a333)
a333y (cadr a333)
zd1x(/ (+ a3x a33x) 2)
zd1y(/ (+ a3y a33y) 2)
zd2x(/ (+ a33x a333x) 2)
zd2y(/ (+ a33y a333y) 2)
zd3x(/ (+ a3x a333x) 2)
zd3y(/ (+ a3y a333y) 2)
zd1 (list zd1x zd1y)
zd2 (list zd2x zd2y)
zd3 (list zd3x zd3y)
a4 (cdr (assoc 90. a1))
) ;_ 结束setq
(if (= a4 3)
(setq wz (inters a3 zd2 a33 zd3))
(setq wz zd3)
) ;_ 结束if
(command "area" "e" obj)
(setq a(atof (rtos (getvar "area")))
mj (rtos a 2 2)
) ;_ 结束setq
(if (= "阳台线" (strcase (cdr (assoc 8. a1))))
(setq mj (strcat MJ "/2"))
(setq MJ MJ)
) ;_ 结束if
(command "text" "j" "m" wz "0" mj)
(if (= "阳台线" (strcase (cdr (assoc 8. a1))))
(setq A0 (+ (/ (atof (rtos A 2 2)) 2) A0))
(setq A0 (+ (atof (rtos A 2 2)) A0))
) ;_ 结束if
(setq i (+ i 1)
) ;_ 结束setq
) ;_ 结束repeat
(prompt "本次选择对象总面积=")
(princ (rtos A0 2 2))
(SETQ SZI (ENTSEL "\n请选择要替换为面积的文字:"))
(command "CHANGE"
szi
""
""
""
""
""
(rtos a0 2 2)
)
(command "osmode" 131)
(princ)
) ;_ 结束defun
(defun c:BC () ;标注组线边长
(command "style" "d" "txt.SHX" "0.216" "1.0" "" "" "" "")
(command "osmode" 0)
(setq ss (ssget "x"))
(command "change" ss "" "p" "c" "bylayer" "LT" "BYLAYER" "")
(setq s (ssget (list (cons 0 "LWPOLYLINE")))
n (sslength s)
i 0
) ;_ 结束setq
(setvar "dimzin" 1)
(repeat n
(if (= (fix (atof (getvar "acadver"))) 14)
(setq gs 12)
(setq gs 14)
) ;_ 结束if
(setq obj (ssname s i)
a1(entget obj)
a4(cdr (assoc 90. a1))
) ;_ 结束setq
(repeat (- a4 1)
(setq
a2(nth gs a1)
a3(cdr a2)
a22 (nth (+ 4 gs) a1)
a33 (cdr a22)
) ;_ 结束setq
(command "dist" a3 a33)
(setq a3x(atof (rtos (car a3)))
a3y(atof (rtos (cadr a3)))
a33x (atof (rtos (car a33)))
a33y (atof (rtos (cadr a33)))
a (getvar "distance")
mj (rtos a 2 2)
) ;_ 结束setq
(if (< A3X A33X)
(setq fse (angle a3 a33))
(setq fse (angle a33 a3))
) ;_ 结束if
(setq fse (* fse 180.0)
fse (/ fse pi)
dwx (/ (+ a33x a3x) 2)
dwy (/ (+ a3y a33y) 2)
dw(list dwx dwy)
) ;_ 结束setq
(if (= fse 180)
(setq fse (- fse 180))
) ;_ 结束if
(if (= fse 270)
(setq fse (- fse 180))
) ;_ 结束if
(command "-layer" "m" "边长" "c" "7" "" "")
(command "text" "j" "bc" dw fse mj)
(setq gs (+ gs 4))
) ;_ 结束repeat
(if (= (fix (atof (getvar "acadver"))) 14)
(setq gs 12)
(setq gs 14)
) ;_ 结束if
(setq
a2(nth gs a1)
a3(cdr a2)
a3x (atof (rtos (car a3)))
a3y (atof (rtos (cadr a3)))
dwx (/ (+ a33x a3x) 2)
dwy (/ (+ a3y a33y) 2)
) ;_ 结束setq
(setq dw (list dwx dwy)
) ;_ 结束setq
(command "dist" a3 a33)
(setq a (getvar "distance")
mj(rtos a 2 2)
fse (angle a33 a3)
fse (* fse 180.0)
fse (/ fse pi)
) ;_ 结束setq
(if (= fse 180)
(setq fse (- fse 180))
) ;_ 结束if
(if (= fse 270)
(setq fse (- fse 180))
) ;_ 结束if
(command "text" "j" "bc" dw fse mj)
(setq i (+ i 1))
) ;_ 结束defun
(princ)) ;_ 结束defun
(defun c:SF () ;比例缩放
(command "osmode" 0)
(setq A (atof (getstring "\n 请选择缩放对象:1、面积 2、边长、3、名称 4、全部:")))
(if (= A 1)
(setq s(ssget '((0 . "TEXT") (8 . "面积")))
n(sslength s)
i0
a4 (atof (getstring "\n 请输入比例系数:"))
) ;_ 结束setq
) ;_ 结束if
(if (= A 2)
(setq s(ssget '((0 . "TEXT") (8 . "边长")))
n(sslength s)
i0
a4 (atof (getstring "\n 请输入比例系数:"))
) ;_ 结束setq
) ;_ 结束if
(if (= A 3)
(setq s(ssget '((0 . "TEXT") (8 . "名称")))
n(sslength s)
i0
a4 (atof (getstring "\n 请输入比例系数:"))
)) ;_ 结束setq
(if (= A 4)
(setq s(ssget "X"'(
(-4 . "<OR")
(-4 . "<AND") (0 . "TEXT")(8 . "边长")(-4 . "AND>")
(-4 . "<AND") (0 . "TEXT")(8 . "面积")(-4 . "AND>")
(-4 . "<AND") (0 . "TEXT")(8 . "名称")(-4 . "AND>")
(-4 . "OR>")
))
n(sslength s)
i0
a4 (atof (getstring "\n 请输入比例系数:"))
) ;_ 结束setq
) ;_ 结束if
(repeat n
(setq
obj (ssname s i)
a1(entget obj)
a2(cdr (assoc 11 a1))
) ;_ 结束setq
(command "SCALE" obj "" a2 a4)
(setq i (+ i 1))
(princ)
) ;_ 结束repeat
) ;_ 结束defun
(defun c:IH () ;_ 坐标注点
(command "style" "D" "txt.SHX" "0.5" "1" "" "" "" "")
(command "OSMODE" "")
(while (setq A (getpoint "\n 请输入坐标点:")
D (list (car A) (cadr A)))
(command "POINT" D)
(setq B (list (+ 0.1 (car A)) (cadr A)))
(setq C (getstring "\n 请输入高程值:"))
(IF(= C "")(SETQ C 0))
(command "TEXT" B0C)
(princ D)
(princ C)
)
)
(defun c:wtr ();_ 边框外侧裁剪
(command "-layer" "m" "位置图" "c" "4" "" "")
(command "osmode" 0)
(setq a (entsel "\n请选择矩形边框:")
aaa (car a)
) ;_ 结束setq
(if (= (fix (atof (getvar "acadver"))) 14)
(setq gs 12)
(setq gs 14)
) ;_ 结束if
(command "change" aaa "" "p" "c" "bylayer" "lt" "bylayer" "") ;_ 结束command
(setq aa(entget (car a))
p1(cdr (nth gs aa))
p2(cdr (nth (+ 4 gs) aa))
p3(cdr (nth (+ 8 gs) aa))
p4(cdr (nth (+ 12 gs) aa))
p1x (car p1)
p3x (car p3)
pb(+ 0.1 (abs (/ (- (cadr p1) (cadr p3)) 2)))
wz(list (/ (+ p1x p3x) 2)
(+ pb (/ (+ (cadr p1) (cadr p3)) 2))
) ;_ 结束list
WZ1 (LIST(+ 60 (CAR WZ))(CADR WZ))
) ;_ 结束setq
(if (< p1x p3x)
(setq p0 (list (- p1x 0.001) (- (cadr p1) 0.001))
pj p1
) ;_ 结束SETQ
(setq p0 (list (+ p1x 0.001) (+ (cadr p1) 0.001))
pj p1
) ;_ 结束SETQ
) ;_ 结束IF
(command "OFFSET" pj p0 aaa p0 "")
(setq b (entget (entlast))
p11 (cdr (nth gs b))
p12 (cdr (nth (+ 4 gs) b))
p13 (cdr (nth (+ 8 gs) b))
p14 (cdr (nth (+ 12 gs) b))
) ;_ 结束SETQ
(command "erase" (entlast) "")
(command "trim" aaa "" "f" p11 p12 "" "f" p12 p13 "" "f" p13 p14 ""
"f" p11 p14 "" "") ;_ 结束command
;_ 结束command
(command "change""w"p1 p3"""p""la""change""""layer" "s" 0"f"" layer" "") ;_ 结束command
(command "erase" "all" "" "" "layer" "t" "*" "" "PEDIT" A "W" 0.3 "" "")
(command "style" "standard" "宋体" 12 "" "" "" "" "")
(command "text" "j" "bc" wz 0 "桩 点 位 置 略 图" "" "" ) ;_ 结束command
(command "text" "j" "bc" wz1 0 "比例尺1：3000" "" "" "zoom" "e" "")
(command "purge" "a" "" "n" "SCALE" (ENTLAST) "" WZ1 0.5 )
) ;_ 结束defun
n
;公式,[]表示取整
;k1=[(x-8000)]/NOx
;k2=[(y-80000)]/NOy
;图号为：k2*100+k1
;对应于1/1000,1/2000,1/5000,1/10000,其中NOx分别为;500,1000,2000,4000,NOy为500,1000,3000,6000
;其中1/2000,1/5000,1/10000应在最前方分别加2,3,4，即分别加上;20000,30000,40000
(defun tfh (pt scale / pt NOx NOy tfhm)
(cond ((= scale 1000)(setq NOx 500 NOy 500))
((= scale 2000)(setq NOx 1000 NOy 1000))
((= scale 5000)(setq NOx 2000 NOy 3000))
((= scale 10000)(setq NOx 4000 NOy 6000))
);cond
(setq tfhm(rtos(+(*(fix(/(-(car pt)80000)NOy))100)(fix(/(-(cadr pt)8000)NOx)))2 0))
(cond ((= scale 1000)
(if (<(strlen tfhm) 5)(setq tfhm (strcat "0" tfhm))))
((= scale 2000)(setq tfhm (strcat "2" tfhm)))
((= scale 5000)(setq tfhm (strcat "3" tfhm)))
((= scale 10000)(if(=(strlen tfhm)3)(setq tfhm (strcat "40" tfhm))(setq tfhm(strcat "4" tfhm))))
);cond
(setq tfhm tfhm);最后加上这句以确保该函数返回值为tfhm
);defun
(defun c:tfh (/ pt scale1 NOx NOy tfhm pt1 pt2 pt3 pt4)
(prompt "本程序用于求龙岗区1:1000、1:2000、1:5000和1:10000的图幅号")
(if(or(not(numberp scale))(= scale 0)) (setq scale 1000))
(setq scale1 (getreal(strcat "\n请输入比例尺<1:" (rtos scale)">：1:")))
(if (and (/= scale1 0)(not(null scale1))) (setq scale scale1))
(cond ((= scale 1000)(setq NOx 500 NOy 500))
((= scale 2000)(setq NOx 1000 NOy 1000))
((= scale 5000)(setq NOx 2000 NOy 3000))
((= scale 10000)(setq NOx 4000 NOy 6000))
);cond
(setq pt (getpoint "\n请输入座标点："))
(while pt
(if (/= pt nil)(progn
(setq tfhm (tfh pt scale))
(prompt (strcat "[" tfhm "]"))
));progn,if
(setq pt1(list(+ 80000(* NOy(atof(if(= scale 1000)(substr tfhm 1 3)(substr tfhm 2 2)))))(+ 8000(* NOx(atof(substr tfhm 4 2)))))
pt2 (mapcar '+ pt1 (list NOy 0.0))
pt3 (mapcar '+ pt1 (list NOy NOx))
pt4 (mapcar '+ pt1 (list 0.0 NOx))
)
(grdraw pt1 pt2 7)
(grdraw pt2 pt3 7)
(grdraw pt3 pt4 7)
(grdraw pt4 pt1 7)
(setq pt (getpoint "\n请输入座标点："))
);while
(princ)
);defun
(defun c:lar (/ scale1 sst lay cmdech obsmod) ;标注面积程序，命令为lar
(setq cmdech (getvar "cmdecho"));状态保存
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq obsmod (getvar "osmode"));状态保存
(setq lay (getvar "clayer"));状态保存
(command "layer" "make" "LABEL" "")
(setq txtsty (getvar "textstyle"));状态保存
(command "style" "label" "宋体" "" "" "" "" "")
(prompt (strcat "\n请输入比例尺<1:" (rtos (if (or (null scale) (not (numberp scale))) (setq scale 1000) scale) 2 0) ">：1:"))
(if (not (null (setq scale1 (getreal))))
(setq scale scale1)
)
(setvar "osmode" 0)
(setq sst (entsel "\n请选择要标注面积的实体："))
(command "area" "object" sst)
(command "text" (cadr sst) (* 0.003 scale) 0 (strcat "S=" (rtos (getvar "area") 2 2) "平方米"))
(prompt "\n请点取标注位置：")
(command "move" (entlast) "" (cadr sst) pause)
(setvar "textstyle" txtsty);状态恢复
(setvar "osmode" obsmod);状态恢复
(setvar "clayer" lay);状态恢复
(command "undo" "end")
(setvar "cmdecho" cmdech);状态恢复
(princ)
)
(defun c:TX(/ pd0 tb) (setq pd0 (entsel "\n选择边线:") tb "") (tX pd0 tb) (princ))
(defun c:TRE(/ pd0 tb) (setq pd0 (entsel "\n选择边线:") tb "E") (tX pd0 tb) (princ))
(defun tX(pd0 tb / pd e1 e2 e e0 h hi p xl yl xr yr d d1 s n na ma tfh ptf year)
(command "UNDO" "Group")
(command "osnap" "" "pedit" pd0 "w" 0 "" "")
(setq pd pd0hi 0.2e0 (tp pd hi)e '()xl 900000yl 900000xr 0yr 0)
(foreach p e0(setq y (car p)x (cadr p))
(setq xl (min x xl)yl (min y yl)e (cons (list y x) e))
(setq xr (max x xr)yr (max y yr))
)
(setq e0 (reverse e)h (* (1+ (fix (/ (max (- xr xl) (- yr yl)) 400))) 6.0))
(setq pd pd0 year 0 ptf nil)
(cond
((wcmatch tb "*10*") (setq ma 400 ptf (mp ma e0 ptf)))
((wcmatch tb "*5*")(setq ma 300 ptf (mp ma e0 ptf)))
((wcmatch tb "*2*")(setq ma 200 ptf (mp ma e0 ptf)))
((wcmatch tb "*0*")(setq ma 0 ptf (mp ma e0 ptf)))
)
(command "ZOOM" (list (- yl h) (- xl h)) (list (+ yr h) (+ xr h))"REGEN")
(if ptf (foreach tfh (car ptf)(dx tfh year)))
(setq d (list (- yl h) (- xl h))) (command "OFFSET" h pd0 d "")
(setq pd (cons (entlast) d)e1 (car (tp pd hi))e2 (car e0))
(setq e (ATAN (- (cadr e2) (cadr e1)) (- (car e2) (car e1))))
(setq d1 (list (+ (car e2) (cos e)) (+ (cadr e2) (sin e)))e0 '())
(command "ERASE" (car pd) "" "OFFSET" 1.0 pd0 d1 "")
(setq pd (cons (entlast) d1))
(foreach p (tp pd hi) (setq e0 (cons (list (car p) (cadr p)) e0)))
(command "ERASE" (car pd) "")
(if (wcmatch tb "*L*") (setq d d1))
(repeat 3 (setq h (* 0.5 h)) (command "OFFSET" h pd0 d"")
(setq pd (cons (entlast) d)e (tp pd hi)e1 nil)
(foreach p e(setq e2 (list (car p) (cadr p)))
(if e1 (command "TRIM" pd0 "" "f" e1 e2 "" ""))(setq e1 e2)
)
(command "TRIM" pd0 "" "f" e1 (list (car (car e)) (cadr (car e))) "" "")
(command "ERASE" (car pd) "")
)
(if (wcmatch tb "*E*") (progn
(setq s (ssget "CP" e0))
(if (= (wcmatch tb "*L*") nill) (progn
(setq s1 s s (ssget "x")n 0)
(if s1 (repeat (sslength s1) (setq na (ssname s1 n)n (1+ n)s (ssdel na s))))
))
(setq n 0s1 (ssdel (car pd0) s))(if s1 (setq s s1))
(if s (repeat (sslength s) (setq na (ssname s n) n (1+ n)) (command "ERASE" na "")))
))
(command "UNDO" "End")
)
(defun tp (pd hi / e e1 ee x y h xa xb ya yb)
(setq e '()h 0.0ya nil)
(foreach ee (entget (car pd))
(if (= (car ee) 10) (progn (setq y (cadr ee)x (caddr ee))
(if (= ya nil) (setq ya yxa x))
(setq e (tpa x y xa ya h e hi))
))
(if (= (car ee) 42) (setq h (cdr ee)ya yxa x))
)
(setq y (car (car (reverse e)))x (cadr (car (reverse e))))
(setq e (tpa x y xa ya h e hi))(reverse e)
)(defun tpa (x y xa ya h e hi / d r a a1 a2 a3 a4 xb yb k n)
(command "DIST" (list ya xa) (list y x))(setq d (getvar "DISTANCE"))
(if (> d 0.02) (progn (setq r 0.0)
(if (/= h 0) (setq r (/ (* d (+ 1 (* h h))) 4 h)))
(setq e (cons (list ya xa h r) e))
(if (/= h 0) (progn (setq pi 3.1415926535898)
(setq a (ATAN (- x xa) (- y ya)) r (abs r))
(if (< h 0) (setq a (+ a (/ pi 2))) (setq a (- a (/ pi 2))))
(while (< a 0) (setq a (+ a pi pi)))(while (> a (* pi 2)) (setq a (- a pi pi)))
(setq yb (- (/ (+ ya y) 2) (* (- r (abs (* d h 0.5))) (cos a))))
(setq xb (- (/ (+ xa x) 2) (* (- r (abs (* d h 0.5))) (sin a))))
(setq a1 (ATAN (- xa xb) (- ya yb)))(if (< a1 0) (setq a1 (+ a1 pi pi)))
(setq a2 (ATAN (- x xb) (- y yb))) (if (< a2 0) (setq a2 (+ a2 pi pi)))
(setq a3 (- a2 a1)a4 (- (+ a1 (/ a3 2)) a))
(while (< a4 0) (setq a4 (+ a4 pi pi)))
(while (> a4 (* pi 2)) (setq a4 (- a4 pi pi)))
(if (and (> (abs a4) 2) (< (abs a4) 4))
(if (minusp a3) (setq a3 (+ a3 pi pi)) (setq a3 (- a3 pi pi)))
)
(setq a (sqrt (/ (* 6 hi) r)) k (1+ (fix (/ (abs a3) a 2))))
(setq a (/ a3 k 2) h (abs (/ (* (- a (sin a)) r) (sin a)))n 0)
(while (< n k) (setq n (1+ n)d (+ (* n a 2) a1))
(setq a3 (+ yb (* (+ r h) (cos (- d a)))))
(setq a4 (+ xb (* (+ r h) (sin (- d a)))))
(setq e (cons (list a3 a4 "L" "L") e))
(if (< n k) (progn
(setq a3 (+ yb (* r (cos d))) a4 (+ xb (* r (sin d))))
(setq e (cons (list a3 a4 "L" "L") e))
)))
))))
(setq d e)
)
(defun c:qq()
(setq ss (ssget))
(setq nn (ssname ss 0))
(setq ent (entget nn))
(setq ent (member (assoc 39 ent) ent))
(setq p1 (cdr (assoc 10 ent)))
(setq x1 (cadr p1))
(setq y1 (car p1))
(setq aa (getpoint "请选点:"))
(setq x (car aa))
(setq y (cadr aa))
(setq i 0
j 1
)
(command "color" 7)
(setvar "textsize" 4) ;改文本的小
(command "text" (list (+ y1 1.0) (+ x1 1.0)) "" "" "1")
(command "text" (list (- x 10) y) "" "" "1")
(command "text" (list x y) "" "" (rtos x1 2 2) "")
(command "text" (list (+ x 23) y) "" "" (rtos y1 2 2) "") ;23代表方格宽度
(setq ent (member (assoc 42 ent) ent))
(print ent)
(while (setq pp (assoc 10 ent))
(setq pp (cdr pp)
x1 (cadr pp)
y1 (car pp)
)
(setq i (1+ i)
j (1+ j)
)
(command "text" (list (+ y1 1.0) (+ x1 1.0)) "" "" (itoa j))
(command "text" (list (- x 10) (- y (* i 4.85))) "" "" (itoa j))
(command "text" (list x (- y (* i 4.85))) "" "" (rtos x1 2 2) "") ;4.85代表方格高度
(command "text" (list (+ x 23) (- y (* i 4.85))) "" "" (rtos y1 2 2) "");23，4.85如上所表示
(setq ent (cdr ent))
(setq ent (member (assoc 42 ent) ent))
)
)
;标注座标程序，命令为lcd
(defun c:lcd (/ pt pt1 scale1 sst lay cmdech obsmod elist sstt)
(setq cmdech (getvar "cmdecho"));状态保存
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq obsmod (getvar "osmode"));状态保存
(setq lay (getvar "clayer"));状态保存
(command "layer" "make" "LABEL" "")
(setq txtsty (getvar "textstyle"));状态保存
(command "style" "label" "宋体" "" "" "" "" "")
(prompt "\n此命令仅适用于多义线标注坐标！")
(prompt (strcat "\n请输入比例尺<1:" (rtos (if (or (null scale) (not (numberp scale))) (setq scale 1000) scale) 2 0) ">：1:"))
(if (not (null (setq scale1 (getreal))))
(setq scale scale1)
)
(setq sst (entsel "\n请点取要标注坐标的实体："))
(setq elist (entget (car sst))
pt (cdr (assoc 10 (entget (car sst)))))
(while pt
(setvar "osmode" 0)
(command "pline" pt (polar pt 0 (* 0.021 scale)) "")
(setq sstt (ssget "l"))
(command "text" (mapcar '- pt (list 0 (* 0.003 scale))) (* 0.0025 scale) 0 (strcat "Y=" (rtos (car pt) 2 3)))
(ssadd (entlast) sstt)
(command "text" (mapcar '+ pt (list 0 (* 0.00075 scale))) (* 0.0025 scale) 0 (strcat "X=" (rtos (cadr pt) 2 3)))
(ssadd (entlast) sstt)
(prompt "\n请点取标注位置：")
(command "move" sstt "" pt pause)
(setq pt1 (getvar "lastpoint"))
(if (<= (car pt) (+ (car pt1) (* 0.0105 scale)))
(command "pline" pt pt1 "")
(command "pline" pt (mapcar '+ pt1 (list (* 0.021 scale) 0)) "")
);if<=
(if(or(= obsmod 0)(>= obsmod 16385))(setvar "osmode" 1)
(setvar "osmode" obsmod))
(if(not(null pt))(prompt(strcat(rtos(car pt))","(rtos(cadr pt)))))
(setq elist (subst '(0) (assoc 10 elist)elist)
pt (cdr (assoc 10 elist)))
);while
(setvar "textstyle" txtsty);状态恢复
(setvar "osmode" obsmod);状态恢复
(setvar "clayer" lay);状态恢复
(command "undo" "end")
(setvar "cmdecho" cmdech);状态恢复
(princ)
)
会不会07版已经很完美了，桌子在退步？ 自己加载测试啊，哪里出错改哪里 试试lispsys改为1，重启cad看行不行？ tigcat 发表于 2022-8-8 12:55
试试lispsys改为1，重启cad看行不行？
高手啊，一点就破～ lispsys改为1 但是CAD2020中输入lispsys 是未知命令咦什么原因呢查了下大概说2021才有咦 高手真多，一点就破:lol
页:
[1]