明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2282|回复: 5

多段线长度批量标注

[复制链接]
发表于 2019-6-22 20:37 | 显示全部楼层 |阅读模式
本帖最后由 树櫴希德 于 2019-6-22 20:39 编辑

  1. (defun spbz (pt1 pt2 pt3 /  )

  2.      
  3. ;12、倾斜标注  
  4. (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 pt1) '(70 . 33) '(1 . "") '(100 . "AcDbAlignedDimension")
  5.    (cons 13 pt2) (cons 14 pt3)
  6.     )
  7.   )
  8. )


  9. (DEFUN BFZ (pzx / i  ll lll pzxa)
  10. ;(setq pzx '(1 2 3 4))
  11. (setq i 0) (setq ll '())
  12. (repeat (- (length pzx)1)
  13.    (setq lll (list (nth i pzx) (nth (+ i 1) pzx)  ))
  14.   (setq pzxa (cons lll pzxa))
  15.   (setq i (1+ i))
  16. )
  17. pzxa
  18. )


  19. ;(setq en (car (entsel "\n请选择需要标注的线段")))




  20. (setq zbb(mapcar  '(lambda (x) (CDR X) )  (vl-remove-if-not '(LAMBDA (X) (=(CAR X)10))   (CDR(entget(car(entsel"\n请选择需要标注的线段"))))) ))

  21. (mapcar  '(lambda (x) (spbz (polar (car x) (+(angle (car x) (cadr x))(* 0.5 pi)) 1.5)
  22.   (car x) (cadr x))

  23.       )   (bfz zbb))
 楼主| 发表于 2019-8-2 11:54 | 显示全部楼层
  1. (defun mai_make_panel ( menulist / n num_nobut num_button nn nnn menuname val_lst add_dclrow tt order_lst in num_image)
  2.   (defun add_dclrow ( dstr / ) (if dstr (setq val_lst (cons dstr val_lst))))
  3.   (setq menuname (strcat (vl-filename-mktemp) "temp_pannel.dcl"))
  4.   (add_dclrow "curbutton:button{width=10;vertical_margin=none;vertical_margin=none;}")
  5.   (add_dclrow "curimage:image{width=10;height=0.2;vertical_margin=none;vertical_margin=none;}")
  6.   (add_dclrow "curpanel:dialog{label=\"天正插件T20命令面板\";alignment=centered;vertical_margin=none;horizontal_margin=none;")
  7.   (add_dclrow ":row{")
  8.   (setq len (apply 'max (mapcar 'length menulist))
  9.         order_lst (apply 'append (mapcar 'cdr menulist))
  10.         num_button 0
  11.         num_nobut 0
  12.         in 0
  13.         num_image 0
  14.   )
  15.   (foreach nn menulist
  16.         (setq in 0)
  17.         (add_dclrow (strcat " : boxed_column{label=\"" (car nn) "\";vertical_margin=none; horizontal_margin=none;"))
  18.         (foreach nnn (cdr nn)
  19.            (setq num_button (1+ num_button)
  20.                  in (1+ in)
  21.                  num_image (1+ num_image)
  22.                  tt (car nnn)
  23.                  tt (if tt tt "")
  24.            )
  25.            (add_dclrow (strcat ":curbutton{label=\"" tt "\";key=\"but" (itoa num_button) "\";}"))
  26.            (if (= 4 in)
  27.                (progn (add_dclrow (strcat ":curimage{key=\"ima" (itoa num_image) "\";color=18;}"))
  28.                       (setq in 0)
  29.                )
  30.            )
  31.         )
  32.         (repeat (- len (length nn))
  33.            (setq num_nobut (1+ num_nobut)
  34.                  in (1+ in)
  35.                  num_image (1+ num_image)
  36.            )
  37.            (add_dclrow (strcat " : curbutton{key=\"butno" (itoa num_nobut) "\";color=-2;}"))
  38.            (if (= 4 in)
  39.                (progn (add_dclrow (strcat ":curimage{key=\"ima" (itoa num_image) "\";}"))
  40.                       (setq in 0)
  41.                )
  42.            )
  43.         )
  44.         (add_dclrow "spacer;}")
  45.   )
  46.    (add_dclrow "}:button{label=\"关闭\";key=\"cancel\";is_cancel=true;width=10;fixed_width=true;alignment=centered;}}")
  47.    (vl-file-delete menuname)
  48.    (setq nn (open menuname "w"))
  49.    (foreach n (reverse val_lst) (write-line n nn))
  50.    (close nn)
  51.    (setq nnn (load_dialog menuname))
  52.    (if (not (new_dialog "curpanel" nnn)) (exit))
  53.    (setq n 0)
  54.    (repeat num_nobut (mode_tile (strcat "butno" (itoa num_nobut)) 1) (setq num_nobut (1- num_nobut)))
  55.   (foreach nn menulist
  56.         (foreach nnn (cdr nn)
  57.            (setq n (1+ n)
  58.                  tt (car nnn)
  59.                  tt (if tt tt "")
  60.            )
  61.            (if (= tt "")
  62.                (mode_tile (strcat "but" (itoa n)) 1)
  63.                (action_tile (strcat "but" (itoa n)) (strcat "\(done_dialog " (itoa n) "\)"))
  64.            )
  65.         )
  66.   )
  67.    (setq nn (start_dialog))
  68.    (unload_dialog nnn)
  69.    (vl-file-delete menuname)
  70.   (if (> nn 0)
  71.        (progn (setq tt (cadr (nth (1- nn) order_lst)))
  72.               (princ "\n")
  73.               (if (= (eval (read (strcat "(type c:" tt ")"))) 'SUBR)
  74.                   (eval (read (strcat "(c:" tt ")")))
  75.                   (vl-cmdf tt)
  76.               )
  77.        )
  78.    )
  79. )

  80. (defun c:t20 ()

  81.   (mai_make_panel
  82. (list
  83. (list "天正插件命令"
  84. (list "版本信息" "tbbxx")
  85. (list "炸开实体" "texplode")
  86. (list "批量转旧版本" "tbatsave")
  87.       nil
  88. (list "图形导出" "tsaves")
  89.   (list "图纸保护" "tprotect")   
  90.     )


  91. ) )
  92.   (princ)
  93. )
  94. (princ "\n天正插件命令t20")

 楼主| 发表于 2019-11-17 16:20 | 显示全部楼层
  1. (vl-load-com)
  2. (vl-load-com)
  3. (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);桩号查询
  4. (prompt "2010-07-27 zo roo  CGGC 武赤公路")
  5. (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
  6. (setq old_lay (getvar "clayer"))
  7. (if (=(tblobjname "LAYER" "桩号标注") nil)
  8.     (progn
  9.         (entmake (list
  10.                     '(0 . "LAYER")
  11.                     '(100 . "AcDbSymbolTableRecord")
  12.                     '(100 . "AcDbLayerTableRecord")
  13.                     '(6 . "CONTINUOUS")
  14.                     '(62 . 3)
  15.                     '(70 . 0)
  16.                     (cons 2 "桩号标注")
  17.                   )
  18.         )
  19.     )
  20. )
  21. (setvar "clayer" "桩号标注")
  22. (setq en  (entsel "\n选择道路中心线: ")
  23. a (getreal "\n请输入起点桩号:")
  24. e   (car en)
  25. pt  (cadr en)
  26. )
  27. (if (setq len 2.000) ;此处要加入非法输入的控制
  28.       (progn
  29. (setq OBJ (vlax-ename->vla-object (car en)))
  30. )
  31. )
  32. (while (setq pt0 (getPoint "\n选择查询点:"))
  33. ;画曲线的垂线
  34. (setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
  35.     LST   (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
  36.     ANG   (atan (/ (cadr LST) (car LST)))
  37.     pt1   (polar Perpt (+ ANG (* 0.5 pi)) len)
  38.     pt2   (polar Perpt (- ANG (* 0.5 pi)) len)
  39.      ;此处就是你画出来的是水平线的原因,变量换个方向即可
  40.    )
  41. (setq ang2 (angtos (angle pt1 pt2 )0 4) )
  42.    (command "pline" pt0 perpt "")
  43. ;计算桩号
  44.   (setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
  45.   leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
  46.   leng2   (- leng leng1)
  47. )
  48. ;计算桩号
  49. (if (< leng1 0.0) (setq fh "-") (setq fh "+"))
  50. (setq nn1 (fix (/ leng1 1000.0 )))
  51. (setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
  52.      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" )))
  53.      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
  54.      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
  55.      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 3))))
  56.    
  57.   (setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
  58. (setq str_2 (strcat "距离:"(rtos (distance pt0 perpt) 2 3) ))
  59.   
  60.   (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
  61.   (command "text" "j" "MC" pt0 "0.3" ang2 str_1)
  62.   
  63.   (command "text" "j" "MC" (polar pt0 (+ (* pi 2) ang) (* -0.5 (* 1.65406 0.67))) "0.3" ang2 str_2)
  64.   
  65. (setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
  66. (setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
  67. (setq pxy (strcat str_1"中桩坐标:X="px",Y="py))
  68. (princ pxy)
  69. )
  70.   (princ)
  71. )


  72. ;(vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel))) (getpoint) T)  
 楼主| 发表于 2019-11-17 19:37 | 显示全部楼层
标注多段线
  1. (vl-load-com)
  2. (vl-load-com)
  3. (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);桩号查询
  4. (prompt "2010-07-27 zo roo  CGGC 武赤公路")

  5. (setq zbb(mapcar  '(lambda (x) (CDR X) )  (vl-remove-if-not '(LAMBDA (X) (=(CAR X)10))   (CDR(entget(car(entsel"\n请选择需要标注的线段"))))) ))
  6.   
  7. (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
  8. (setq old_lay (getvar "clayer"))
  9. (if (=(tblobjname "LAYER" "桩号标注") nil)
  10.     (progn
  11.         (entmake (list
  12.                     '(0 . "LAYER")
  13.                     '(100 . "AcDbSymbolTableRecord")
  14.                     '(100 . "AcDbLayerTableRecord")
  15.                     '(6 . "CONTINUOUS")
  16.                     '(62 . 3)
  17.                     '(70 . 0)
  18.                     (cons 2 "桩号标注")
  19.                   )
  20.         )
  21.     )
  22. )
  23. (setvar "clayer" "桩号标注")
  24. (setq en  (entsel "\n选择道路中心线: ")
  25. a (getreal "\n请输入起点桩号:")
  26. e   (car en)
  27. pt  (cadr en)
  28. )
  29. (if (setq len 2.000) ;此处要加入非法输入的控制
  30.       (progn
  31. (setq OBJ (vlax-ename->vla-object (car en)))
  32. )
  33. )
  34. ( foreach x zbb  ;while
  35.   ;(setq pt0 (getPoint "\n选择查询点:"))
  36. ;画曲线的垂线
  37.   (setq pt0 x)
  38. (setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
  39.     LST   (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
  40.     ANG   (atan (/ (cadr LST) (car LST)))
  41.     pt1   (polar Perpt (+ ANG (* 0.5 pi)) len)
  42.     pt2   (polar Perpt (- ANG (* 0.5 pi)) len)
  43.      ;此处就是你画出来的是水平线的原因,变量换个方向即可
  44.    )
  45. (setq ang2 (angtos (angle pt1 pt2 )0 4) )
  46.    (command "pline" pt0 perpt "")
  47. ;计算桩号
  48.   (setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
  49.   leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
  50.   leng2   (- leng leng1)
  51. )
  52. ;计算桩号
  53. (if (< leng1 0.0) (setq fh "-") (setq fh "+"))
  54. (setq nn1 (fix (/ leng1 1000.0 )))
  55. (setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
  56.      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" )))
  57.      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
  58.      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
  59.      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 3))))
  60.    
  61.   (setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
  62. (setq str_2 (strcat "距离:"(rtos (distance pt0 perpt) 2 3) ))
  63.   
  64.   (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
  65.   (command "text" "j" "MC" pt0 "0.3" ang2 str_1)
  66.   
  67.   (command "text" "j" "MC" (polar pt0 (+ (* pi 2) ang) (* -0.5 (* 1.65406 0.67))) "0.3" ang2 str_2)
  68.   
  69. (setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
  70. (setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
  71. (setq pxy (strcat str_1"中桩坐标:X="px",Y="py))
  72. (princ pxy)
  73. )
  74.   (princ)
  75. )


  76. ;(vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel))) (getpoint) T)  

 楼主| 发表于 2021-1-4 19:57 | 显示全部楼层
  1. (setq en   (car (entsel "\n拾取:"))
  2.       txt  (getstring "\n后缀:")
  3.       col  (acad_truecolordlg '(62 . 1))
  4.       ent  (entget en)
  5.       txt1 (cdr (assoc 1 ent))
  6.       txt1 (if (= "" txt1)
  7.        "<>"
  8.        txt1
  9.      )
  10.       txt  (strcat txt1 "{\\C" (itoa (cdar col)) ";(" txt ")}")
  11.       ent  (subst (cons 1 txt) (assoc 1 ent) ent)
  12. )
  13. (entmod ent)
标注文字加后缀
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 17:32 , Processed in 0.254894 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表