多段线长度批量标注
本帖最后由 树櫴希德 于 2019-6-22 20:39 编辑(defun spbz (pt1 pt2 pt3 /)
;12、倾斜标注
(entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 pt1) '(70 . 33) '(1 . "") '(100 . "AcDbAlignedDimension")
(cons 13 pt2) (cons 14 pt3)
)
)
)
(DEFUN BFZ (pzx / ill lll pzxa)
;(setq pzx '(1 2 3 4))
(setq i 0) (setq ll '())
(repeat (- (length pzx)1)
(setq lll (list (nth i pzx) (nth (+ i 1) pzx)))
(setq pzxa (cons lll pzxa))
(setq i (1+ i))
)
pzxa
)
;(setq en (car (entsel "\n请选择需要标注的线段")))
(setq zbb(mapcar'(lambda (x) (CDR X) )(vl-remove-if-not '(LAMBDA (X) (=(CAR X)10)) (CDR(entget(car(entsel"\n请选择需要标注的线段"))))) ))
(mapcar'(lambda (x) (spbz (polar (car x) (+(angle (car x) (cadr x))(* 0.5 pi)) 1.5)
(car x) (cadr x))
) (bfz zbb)) (defun mai_make_panel ( menulist / n num_nobut num_button nn nnn menuname val_lst add_dclrow tt order_lst in num_image)
(defun add_dclrow ( dstr / ) (if dstr (setq val_lst (cons dstr val_lst))))
(setq menuname (strcat (vl-filename-mktemp) "temp_pannel.dcl"))
(add_dclrow "curbutton:button{width=10;vertical_margin=none;vertical_margin=none;}")
(add_dclrow "curimage:image{width=10;height=0.2;vertical_margin=none;vertical_margin=none;}")
(add_dclrow "curpanel:dialog{label=\"天正插件T20命令面板\";alignment=centered;vertical_margin=none;horizontal_margin=none;")
(add_dclrow ":row{")
(setq len (apply 'max (mapcar 'length menulist))
order_lst (apply 'append (mapcar 'cdr menulist))
num_button 0
num_nobut 0
in 0
num_image 0
)
(foreach nn menulist
(setq in 0)
(add_dclrow (strcat " : boxed_column{label=\"" (car nn) "\";vertical_margin=none; horizontal_margin=none;"))
(foreach nnn (cdr nn)
(setq num_button (1+ num_button)
in (1+ in)
num_image (1+ num_image)
tt (car nnn)
tt (if tt tt "")
)
(add_dclrow (strcat ":curbutton{label=\"" tt "\";key=\"but" (itoa num_button) "\";}"))
(if (= 4 in)
(progn (add_dclrow (strcat ":curimage{key=\"ima" (itoa num_image) "\";color=18;}"))
(setq in 0)
)
)
)
(repeat (- len (length nn))
(setq num_nobut (1+ num_nobut)
in (1+ in)
num_image (1+ num_image)
)
(add_dclrow (strcat " : curbutton{key=\"butno" (itoa num_nobut) "\";color=-2;}"))
(if (= 4 in)
(progn (add_dclrow (strcat ":curimage{key=\"ima" (itoa num_image) "\";}"))
(setq in 0)
)
)
)
(add_dclrow "spacer;}")
)
(add_dclrow "}:button{label=\"关闭\";key=\"cancel\";is_cancel=true;width=10;fixed_width=true;alignment=centered;}}")
(vl-file-delete menuname)
(setq nn (open menuname "w"))
(foreach n (reverse val_lst) (write-line n nn))
(close nn)
(setq nnn (load_dialog menuname))
(if (not (new_dialog "curpanel" nnn)) (exit))
(setq n 0)
(repeat num_nobut (mode_tile (strcat "butno" (itoa num_nobut)) 1) (setq num_nobut (1- num_nobut)))
(foreach nn menulist
(foreach nnn (cdr nn)
(setq n (1+ n)
tt (car nnn)
tt (if tt tt "")
)
(if (= tt "")
(mode_tile (strcat "but" (itoa n)) 1)
(action_tile (strcat "but" (itoa n)) (strcat "\(done_dialog " (itoa n) "\)"))
)
)
)
(setq nn (start_dialog))
(unload_dialog nnn)
(vl-file-delete menuname)
(if (> nn 0)
(progn (setq tt (cadr (nth (1- nn) order_lst)))
(princ "\n")
(if (= (eval (read (strcat "(type c:" tt ")"))) 'SUBR)
(eval (read (strcat "(c:" tt ")")))
(vl-cmdf tt)
)
)
)
)
(defun c:t20 ()
(mai_make_panel
(list
(list "天正插件命令"
(list "版本信息" "tbbxx")
(list "炸开实体" "texplode")
(list "批量转旧版本" "tbatsave")
nil
(list "图形导出" "tsaves")
(list "图纸保护" "tprotect")
)
) )
(princ)
)
(princ "\n天正插件命令t20")
(vl-load-com)
(vl-load-com)
(defun c:zhcx (/ en old_lay a e perpt pt0 obj len ang leng leng1 leng2 pt1 pt2 str_1 str_2 px py pxy nn1 nn2 pt);桩号查询
(prompt "2010-07-27 zo rooCGGC 武赤公路")
(prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
(setq old_lay (getvar "clayer"))
(if (=(tblobjname "LAYER" "桩号标注") nil)
(progn
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 3)
'(70 . 0)
(cons 2 "桩号标注")
)
)
)
)
(setvar "clayer" "桩号标注")
(setq en(entsel "\n选择道路中心线: ")
a (getreal "\n请输入起点桩号:")
e (car en)
pt(cadr en)
)
(if (setq len 2.000) ;此处要加入非法输入的控制
(progn
(setq OBJ (vlax-ename->vla-object (car en)))
)
)
(while (setq pt0 (getPoint "\n选择查询点："))
;画曲线的垂线
(setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
LST (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
ANG (atan (/ (cadr LST) (car LST)))
pt1 (polar Perpt (+ ANG (* 0.5 pi)) len)
pt2 (polar Perpt (- ANG (* 0.5 pi)) len)
;此处就是你画出来的是水平线的原因，变量换个方向即可
)
(setq ang2 (angtos (angle pt1 pt2 )0 4) )
(command "pline" pt0 perpt "")
;计算桩号
(setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
leng2 (- leng leng1)
)
;计算桩号
(if (< leng1 0.0) (setq fh "-") (setq fh "+"))
(setq nn1 (fix (/ leng1 1000.0 )))
(setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
(if(= nn2 0.0) (setq str_1 (strcat fh "00" )))
(if(and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
(if(and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
(if(>= nn2 100.0)(setq str_1 (strcat fh (rtos nn2 2 3))))
(setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
(setq str_2 (strcat "距离："(rtos (distance pt0 perpt) 2 3) ))
(setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
(command "text" "j" "MC" pt0 "0.3" ang2 str_1)
(command "text" "j" "MC" (polar pt0 (+ (* pi 2) ang) (* -0.5 (* 1.65406 0.67))) "0.3" ang2 str_2)
(setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
(setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
(setq pxy (strcat str_1"中桩坐标：X="px",Y="py))
(princ pxy)
)
(princ)
)
;(vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel))) (getpoint) T) 标注多段线
(vl-load-com)
(vl-load-com)
(defun c:zhcx (/ en old_lay a e perpt pt0 obj len ang leng leng1 leng2 pt1 pt2 str_1 str_2 px py pxy nn1 nn2 pt zbb);桩号查询
(prompt "2010-07-27 zo rooCGGC 武赤公路")
(setq zbb(mapcar'(lambda (x) (CDR X) )(vl-remove-if-not '(LAMBDA (X) (=(CAR X)10)) (CDR(entget(car(entsel"\n请选择需要标注的线段"))))) ))
(prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
(setq old_lay (getvar "clayer"))
(if (=(tblobjname "LAYER" "桩号标注") nil)
(progn
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 3)
'(70 . 0)
(cons 2 "桩号标注")
)
)
)
)
(setvar "clayer" "桩号标注")
(setq en(entsel "\n选择道路中心线: ")
a (getreal "\n请输入起点桩号:")
e (car en)
pt(cadr en)
)
(if (setq len 2.000) ;此处要加入非法输入的控制
(progn
(setq OBJ (vlax-ename->vla-object (car en)))
)
)
( foreach x zbb;while
;(setq pt0 (getPoint "\n选择查询点："))
;画曲线的垂线
(setq pt0 x)
(setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
LST (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
ANG (atan (/ (cadr LST) (car LST)))
pt1 (polar Perpt (+ ANG (* 0.5 pi)) len)
pt2 (polar Perpt (- ANG (* 0.5 pi)) len)
;此处就是你画出来的是水平线的原因，变量换个方向即可
)
(setq ang2 (angtos (angle pt1 pt2 )0 4) )
(command "pline" pt0 perpt "")
;计算桩号
(setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
leng2 (- leng leng1)
)
;计算桩号
(if (< leng1 0.0) (setq fh "-") (setq fh "+"))
(setq nn1 (fix (/ leng1 1000.0 )))
(setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
(if(= nn2 0.0) (setq str_1 (strcat fh "00" )))
(if(and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
(if(and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
(if(>= nn2 100.0)(setq str_1 (strcat fh (rtos nn2 2 3))))
(setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
(setq str_2 (strcat "距离："(rtos (distance pt0 perpt) 2 3) ))
(setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
(command "text" "j" "MC" pt0 "0.3" ang2 str_1)
(command "text" "j" "MC" (polar pt0 (+ (* pi 2) ang) (* -0.5 (* 1.65406 0.67))) "0.3" ang2 str_2)
(setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
(setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
(setq pxy (strcat str_1"中桩坐标：X="px",Y="py))
(princ pxy)
)
(princ)
)
;(vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel))) (getpoint) T)
(setq en (car (entsel "\n拾取:"))
txt(getstring "\n后缀:")
col(acad_truecolordlg '(62 . 1))
ent(entget en)
txt1 (cdr (assoc 1 ent))
txt1 (if (= "" txt1)
"<>"
txt1
)
txt(strcat txt1 "{\\C" (itoa (cdar col)) ";(" txt ")}")
ent(subst (cons 1 txt) (assoc 1 ent) ent)
)
(entmod ent)标注文字加后缀
谢谢分享
页:
[1]