Cass土方5米方格网节点数字转块

树櫴希德 · 发表于 2019-6-25 23:24:29

本帖最后由树櫴希德于 2019-7-1 20:26 编辑

;;name:BF-list-delsame
;;;desc:删除表中相同元素，保留第一次出现的位置
;;;arg:lst:列表
;;;arg:buzz:容差
;;;return:删除重复元素组成的表
;;;exampleBF-list-delsame '(0 1 2 3 2 4 4) 0.1)---->(0 1 2 3 4)
(defun BF-list-delsame (lst buzz)
(if Lst
(cons (car Lst)
(BF-list-delsame
(vl-remove-if
'(lambda (x) (equal (car lst) x buzz))
(cdr lst)
)
buzz
)
)
)
)
;货物分两组（样品库存）
(defun lst22(lst / lst1 lst2)
(setq lst1 '() lst2 '())
(mapcar'(lambda(a)
(if (member a lst2)
(setq lst1 (cons a lst1))
(setq lst2 (cons a lst2))
)
)lst)
(cons (reverse lst2) (reverse lst1))
)
;;;;;;
(defun lst->2lst(lst / lst1 lst2 x y)
(setq lst1 '() lst2 '())
(mapcar'(lambda(x)
(mapcar'(lambda(Y)
(if (equal (distance (car x) (car y) ) 0.000 0.01000)
(progn (setq lst1 (append x (list(last y) ) ) )
(setq lst (vl-remove y lst)) )
)
) (vl-remove x lst) )
(setq lst2 (cons lst1 lst2))
(setq lst (vl-remove x lst))
)LST)
lst2 ;(cadr(lst=====2lst lst2) )
)
;;;;;;;;;;;;;
(defun mkgcd (inspt height height-1 height-2 scale / pt pt1 blkdef obj)
(gc) (vl-load-com)
(setvar "CMDECHO" 0)
(command "layer" "m" "检查高程点" "c" "1" "" "L" "CONTINUOUS" "" "")
(cond ((= (type height) REAL) (setq height (rtos height 2 3)) )
((= (type height) STR) (setq height height) )
((= (type height-1) REAL) (setq height-1 (rtos height-1 2 3)) )
((= (type height-1) STR) (setq height-1 height-1) )
((= (type height-2) REAL) (setq height-2 (rtos height-2 2 3)) )
((= (type height-2) STR) (setq height-2 height-2) )
)
;;;;-------------
; (if height (setq height (rtos height 2 3)) (setq height "") )
;(if height-1 (setq height-1 (rtos height-1 2 3)) (setq height-1 "") )
;;;;-------------
(regapp "SOUTH")
;;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
)
(if (not (tblobjname "style" "宋体"))
(command "-style" "宋体" "宋体" 0 1 0 "" "" "")
)
;;;检查是否存在高程点图块定义
(if (not (tblobjname "block" "GC200"))
(progn
(setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
(setq obj
(vla-AddPolyline
blkdef
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 5))
'(-0.2 0 0 0.2 0 0)
)
)
)
)
(vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
)
)
;;;插入块
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
'(-3 ("SOUTH" (1000 . "84848412")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt (polar inspt (* 0.5 PI) (* 1.8 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 62 3)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "宋体")
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 70 0)
(cons 74 2)
)
)
;;;;;;;;;;;;;;;;;;;;;;;
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt1 (polar inspt (* -0.5 PI) (* 1.8 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 62 3)
(cons 41 0.8)
(cons 51 0)
(cons 1 height-1)
(cons 7 "宋体")
(cons 72 0)
(cons 11 pt1)
'(100 . "AcDbAttribute")
(cons 2 "height-1")
(cons 70 0)
(cons 74 2)
)
)
;;;;;;;;;;;;;;;;;;;;;;;
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt1 (polar inspt (* 1.0 PI) (* 7.0 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 62 3)
(cons 41 0.8)
(cons 51 0)
(cons 1 height-2)
(cons 7 "宋体")
(cons 72 0)
(cons 11 pt1)
'(100 . "AcDbAttribute")
(cons 2 "height-2")
(cons 70 0)
(cons 74 2)
)
)
;;;插入属性
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;;;;;;;;;
;;by Gu_xl
;;;;;;;;;;;;;
(defun cx-ss2en
(ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
((='ename(type ss))
(ssadd ss)
)
)
)
;;;;;;;;;;;;;
(defun subtotals(lst m ns / myfun a b c);;对lst以子表第m项为关键字进行分类,ns为整数时记录第ns项、为表(2 3)记录表中指定的项、为空记录关键字以外所有项
(cond((=(type ns)'LIST)(defun myfun(x)(list(mapcar'(lambda(y)(nth y x))ns))))
((=(type ns)'INT)(defun myfun(x)(LIST(NTH ns x))))
(t(defun myfun(x)(list(vl-remove c x)))))
(foreach x lst
(setq a(if(setq c(nth m x)b(assoc c a))
(subst(append b(myfun x))b a)
(append a(list(append(list c)(myfun x))))))))
;(foreach x(vl-remove-if'(LAMBDA(x)(<(length x)3)) (SUBTOTALS(mapcar'(lambda(x)(setq p(cdr(assoc 10(entget x))))
;(list(list(car p)(cadr p))(last p))) (sstoes(ssget"X"'((8 . "GCD")))))0 1))
;(gxl-cs:gcd x scale))
;(nth 10(SUBTOTALS(mapcar'(lambda(p) (list(list(car p)(cadr p))(last p))) b3) 0 1) )
;(cdr(assoc 10(entget (car(entsel)))))
;(command "pline" (getpoint)(cdr(assoc 11(entget (car(entsel))))) "")
;(command "pline" (getpoint)(cdr(assoc 10(entget (car(entsel))))) "")
;;;;;;;;;;;;;;;;;;
(defun insertgc ( e / e)
(cdr(assoc 10(entget e)))
)
(defun insertgc11 ( e / e)
(cdr(assoc 11(entget e)))
)
(defun insert1 ( e / e)
(distof (cdr(assoc 1(entget e))) 2 )
)
;;;;;;;;;;;;;;;;;;;;;
(defun c:chd ( / ssa ssb b1 b2 zba zba1 zba2 zbb zbb1 zbb2 b3 pzx123 p pzx1234)
(setq ssa (ssget "x"'( (0 . "text") (62 . 2) (8 . "fgw") ) ) ) ;
(setq ssb (ssget "x"'( (0 . "text") (62 . 4) (8 . "fgw") ) ) )
(setq b1 nil) (setq b2 nil)
;(setq zbba (mapcar '(lambda (x) ) ) )
(foreach x (cx-ss2en ssa)
(setq zba (insertgc x)) (setq zba1 (insert1 x)) (setq zba2 (list (-(car zba)0.250) (-(cadr zba)0.250) zba1)) (setq b1 (append b1 (list zba2 )) )
)
(foreach x (cx-ss2en ssb)
(setq zbb (insertgc11 x)) (setq zbb1 (insert1 x)) (setq zbb2 (list (-(car zbb)0.250) (+(cadr zbb)0.250) zbb1)) (setq b2 (append b2 (list zbb2 )) )
)
;(setq b3 (car(lst22(append b1 b2))))
(setq b3 (BF-list-delsame (append b1 b2) 0.010))
;(setq pzx1 (mapcar'(lambda(x) (setq pzx (cons (list (car x) (cadr x)) (list(nth 2 x)) )) )b3 ))
(setq pzx123 (vl-remove-if'(LAMBDA(x)(<(length x)3)) (lst->2lst(mapcar'(lambda(p) (list(list(car p)(cadr p))(last p))) b3) ) ) )
;(mapcar'(lambda(x) (gxl-cs:gcd x 0.5 ) )pzx123 );;;inspt height height-1 scale
(mapcar'(lambda(x) (mkgcd (car x) (rtos (cadr x) 2 3) (rtos (caddr x) 2 3) (rtos (- (cadr x)(caddr x) ) 2 3 ) 0.1 ) ) pzx123 )
;(setq pzx1234 (reverse(vl-sort (mapcar'(lambda(p) (list(list(car p)(cadr p))(last p))) b3) (function (lambda (e1 e2) (equal (distance (car e1) (car e2) ) 0.000 0.001000) ) ) ) ) )
(defun xl-div (lst x / lst2)
(foreach n lst
(if (and lst2 (/= x (length (car lst2))))
(setq lst2 (cons (append (car lst2) (list n)) (cdr lst2)))
(setq lst2 (cons (list n) lst2))
)
)
(reverse lst2)
)
;(mapcar'(lambda(x) (mkgcd (caar x) (rtos (cadar x) 2 3) (rtos (cadadr x) 2 3) (rtos (- (cadar x) (cadadr x) ) 2 3) 0.1) ) (vl-remove-if'(LAMBDA(x)(<(length x)2)) (xl-div pzx1234 2)) )
(princ)
)

;;name:BF-list-delsame 
;;;desc:删除表中相同元素，保留第一次出现的位置 
;;;arg:lst:列表 
;;;arg:buzz:容差 
;;;return:删除重复元素组成的表 
;;;example<img src="static/image/smiley/default/sad.gif" smilieid="2" border="0" alt="" />BF-list-delsame '(0 1 2 3 2 4 4) 0.1)---->(0 1 2 3 4) 
(defun BF-list-delsame (lst buzz) 
  (if Lst 
    (cons (car Lst) 
   (BF-list-delsame 
     (vl-remove-if 
       '(lambda (x) (equal (car lst) x buzz)) 
       (cdr lst) 
     ) 
     buzz 
   ) 
    ) 
  ) 
) 
 
;货物分两组（样品 库存） 
(defun lst22(lst / lst1 lst2) 
  (setq lst1 '() lst2 '()) 
 
  (mapcar'(lambda(a) 
(if (member a lst2) 
      (setq lst1 (cons a lst1)) 
      (setq lst2 (cons a lst2)) 
    ) 
 
      )lst) 
 
(cons (reverse lst2) (reverse lst1)) 
) 
;;;;;; 
(defun lst->2lst(lst / lst1 lst2 x y) 
  (setq lst1 '() lst2 '()) 
 
(mapcar'(lambda(x) 
    (mapcar'(lambda(Y) 
(if  (equal (distance (car x) (car y) ) 0.000 0.01000) 
  (progn  (setq lst1 (append  x (list(last y) ) ) ) 
        (setq lst (vl-remove y lst))    ) 
  )          
        )  (vl-remove x lst)  ) 
    
(setq lst2 (cons lst1 lst2)) 
    (setq lst (vl-remove x lst)) 
    )LST) 
 
   lst2  ;(cadr(lst=====2lst lst2) ) 
 
 
) 
 
;;;;;;;;;;;;; 
(defun mkgcd (inspt height height-1  height-2 scale  / pt  pt1 blkdef obj) 
 (gc)  (vl-load-com) 
  (setvar "CMDECHO" 0) 
  (command "layer" "m" "检查高程点" "c" "1" "" "L" "CONTINUOUS" ""  "") 
(cond ((= (type height) REAL) (setq height (rtos height 2 3))  ) 
     ((= (type height) STR) (setq height height)  ) 
 
 ((= (type height-1) REAL) (setq height-1 (rtos height-1 2 3))  ) 
     ((= (type height-1) STR) (setq height-1 height-1)  ) 
 
       
 ((= (type height-2) REAL) (setq height-2 (rtos height-2 2 3))  ) 
     ((= (type height-2) STR) (setq height-2 height-2)  ) 
  ) 
  ;;;;------------- 
 ; (if height     (setq height (rtos height 2 3))      (setq height  "")   ) 
;(if height-1     (setq height-1 (rtos height-1 2 3))     (setq height-1 "")   ) 
  ;;;;------------- 
  (regapp "SOUTH") 
  ;;;检查字体 "HZ" 是否存在 
  (if (not (tblobjname "style" "HZ")) 
    (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "") 
  ) 
(if (not (tblobjname "style" "宋体")) 
    (command "-style" "宋体" "宋体" 0 1 0 "" "" "") 
  ) 
 
   
  ;;;检查是否存在高程点图块定义 
  (if (not (tblobjname "block" "GC200")) 
    (progn 
      (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200")) 
      (setq obj 
        (vla-AddPolyline 
           blkdef 
           (vlax-make-variant 
              (vlax-safearray-fill 
                 (vlax-make-safearray vlax-vbdouble (cons 0 5)) 
                 '(-0.2 0 0 0.2 0 0) 
              ) 
           ) 
        ) 
      ) 
      (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1) 
      (vla-put-Closed obj :vlax-true) 
      (vla-put-ConstantWidth obj 0.4) 
    ) 
  ) 
  ;;;插入块 
  (entmake (list 
             '(0 . "INSERT") 
             '(100 . "AcDbEntity") 
             '(100 . "AcDbBlockReference") 
             '(66 . 1);;;属性跟随标志,1跟随，0不跟随 
              (cons 2 "GC200") 
              (cons 10 inspt) 
              (cons 41 scale) 
              (cons 42 scale) 
              (cons 43 scale) 
              '(-3 ("SOUTH" (1000 . "84848412"))) 
           ) 
  ) 
  ;;;插入属性 
  (entmake (list 
             '(0 . "ATTRIB") 
             '(100 . "AcDbEntity") 
             '(100 . "AcDbText") 
              (cons 10 (setq pt (polar inspt (* 0.5 PI) (* 1.8 scale)))) 
              (cons 40 (* 2.0 scale)) 
              (cons 50 0) 
               (cons 62 3) 
              (cons 41 0.8) 
              (cons 51 0) 
              (cons 1 height) 
              (cons 7 "宋体") 
              (cons 72 0) 
              (cons 11 pt) 
              '(100 . "AcDbAttribute") 
              (cons 2 "height") 
              (cons 70  0) 
              (cons 74 2) 
           ) 
   ) 
;;;;;;;;;;;;;;;;;;;;;;; 
  (entmake (list 
             '(0 . "ATTRIB") 
             '(100 . "AcDbEntity") 
             '(100 . "AcDbText") 
              (cons 10 (setq pt1 (polar inspt (* -0.5 PI) (* 1.8 scale)))) 
              (cons 40 (* 2.0 scale)) 
              (cons 50 0) 
               (cons 62 3) 
              (cons 41 0.8) 
              (cons 51 0) 
              (cons 1 height-1) 
              (cons 7 "宋体") 
              (cons 72 0) 
              (cons 11 pt1) 
              '(100 . "AcDbAttribute") 
              (cons 2 "height-1") 
              (cons 70  0) 
              (cons 74 2) 
           ) 
   ) 
 
  ;;;;;;;;;;;;;;;;;;;;;;; 
  (entmake (list 
             '(0 . "ATTRIB") 
             '(100 . "AcDbEntity") 
             '(100 . "AcDbText") 
              (cons 10 (setq pt1 (polar inspt (* 1.0 PI) (* 7.0 scale)))) 
              (cons 40 (* 2.0 scale)) 
              (cons 50 0) 
               (cons 62 3) 
              (cons 41 0.8) 
              (cons 51 0) 
              (cons 1 height-2) 
              (cons 7 "宋体") 
              (cons 72 0) 
              (cons 11 pt1) 
              '(100 . "AcDbAttribute") 
              (cons 2 "height-2") 
              (cons 70  0) 
              (cons 74 2) 
           ) 
   ) 
;;;插入属性 
 
   
   
   
   ;;;结束标志 
   (entmake '((0 . "SEQEND"))) 
   (princ) 
) 
;;;;;;;;;;; 
 
 
;;by Gu_xl 
 
;;;;;;;;;;;;; 
(defun cx-ss2en 
  (ss / enlst) 
  (cond 
    ((= (type ss) 'PICKSET) 
      (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS))) 
    ) 
    ((= (type ss) 'LIST) 
      (setq enlst (ssadd)) 
      (last (mapcar '(lambda (x) (ssadd x enlst)) ss)) 
    ) 
    ((='ename(type ss)) 
      (ssadd ss) 
    ) 
  ) 
) 
;;;;;;;;;;;;; 
(defun subtotals(lst m ns / myfun a b c);;对lst以子表第m项为关键字进行分类,ns为整数时记录第ns项、为表(2 3)记录表中指定的项、为空记录关键字以外所有项 
  (cond((=(type ns)'LIST)(defun myfun(x)(list(mapcar'(lambda(y)(nth y x))ns)))) 
       ((=(type ns)'INT)(defun myfun(x)(LIST(NTH ns x)))) 
       (t(defun myfun(x)(list(vl-remove c x))))) 
  (foreach x lst 
    (setq a(if(setq c(nth m x)b(assoc c a)) 
       (subst(append b(myfun x))b a) 
       (append a(list(append(list c)(myfun x)))))))) 
 
;(foreach x(vl-remove-if'(LAMBDA(x)(<(length x)3)) (SUBTOTALS(mapcar'(lambda(x)(setq p(cdr(assoc 10(entget x)))) 
       ;(list(list(car p)(cadr p))(last p)))  (sstoes(ssget"X"'((8 . "GCD")))))0 1)) 
    ;(gxl-cs:gcd x scale)) 
 
 
 
;(nth 10(SUBTOTALS(mapcar'(lambda(p)  (list(list(car p)(cadr p))(last p)))  b3) 0 1) ) 
 
 
;(cdr(assoc 10(entget (car(entsel))))) 
 
;(command "pline" (getpoint)(cdr(assoc 11(entget (car(entsel))))) "") 
 
;(command "pline" (getpoint)(cdr(assoc 10(entget (car(entsel))))) "") 
 
 
;;;;;;;;;;;;;;;;;; 
(defun insertgc ( e / e) 
  (cdr(assoc 10(entget e))) 
  ) 
(defun insertgc11 ( e / e) 
  (cdr(assoc 11(entget e))) 
  ) 
 
(defun insert1 ( e / e) 
  (distof (cdr(assoc 1(entget e))) 2 ) 
  ) 
;;;;;;;;;;;;;;;;;;;;; 
(defun c:chd ( / ssa ssb b1 b2 zba zba1 zba2 zbb zbb1 zbb2 b3 pzx123 p pzx1234) 
(setq ssa (ssget "x"'( (0 . "text") (62 . 2) (8 . "fgw") ) ) ) ; 
 
(setq ssb (ssget "x"'( (0 . "text") (62 . 4) (8 . "fgw") ) ) ) 
(setq b1 nil) (setq b2 nil) 
;(setq zbba (mapcar '(lambda (x) ) )       ) 
 
(foreach x (cx-ss2en ssa) 
 
    (setq zba (insertgc x)) (setq zba1 (insert1 x)) (setq zba2 (list (-(car zba)0.250) (-(cadr zba)0.250) zba1)) (setq b1 (append b1 (list zba2 )) ) 
   ) 
(foreach x (cx-ss2en ssb) 
 
    (setq zbb (insertgc11 x)) (setq zbb1 (insert1 x)) (setq zbb2 (list (-(car zbb)0.250) (+(cadr zbb)0.250) zbb1)) (setq b2 (append b2 (list zbb2 )) ) 
   ) 
 
;(setq b3 (car(lst22(append b1 b2)))) 
  (setq b3 (BF-list-delsame (append b1 b2) 0.010)) 
;(setq pzx1 (mapcar'(lambda(x)  (setq pzx (cons (list (car x) (cadr x)) (list(nth 2 x)) )) )b3 )) 
 
(setq pzx123 (vl-remove-if'(LAMBDA(x)(<(length x)3))  (lst->2lst(mapcar'(lambda(p)  (list(list(car p)(cadr p))(last p)))  b3) )  )   ) 
 
;(mapcar'(lambda(x)  (gxl-cs:gcd x 0.5 ) )pzx123 );;;inspt height height-1 scale 
 
 
(mapcar'(lambda(x)  (mkgcd (car x) (rtos (cadr x) 2 3)  (rtos (caddr x) 2 3)  (rtos (- (cadr x)(caddr x) ) 2 3 ) 0.1 ) ) pzx123 ) 
 
 
 
 
;(setq pzx1234 (reverse(vl-sort (mapcar'(lambda(p)  (list(list(car p)(cadr p))(last p)))  b3) (function (lambda (e1 e2) (equal (distance (car e1) (car e2) ) 0.000 0.001000)   ) ) )  ) ) 
 
 
 
 
(defun xl-div (lst x / lst2) 
  (foreach n lst 
    (if        (and lst2 (/= x (length (car lst2)))) 
      (setq lst2 (cons (append (car lst2) (list n)) (cdr lst2))) 
      (setq lst2 (cons (list n) lst2)) 
    ) 
  ) 
    (reverse lst2) 
 
) 
;(mapcar'(lambda(x)   (mkgcd  (caar x)    (rtos (cadar x) 2 3)  (rtos (cadadr x) 2 3)   (rtos (- (cadar x) (cadadr x)  ) 2 3)   0.1)     )   (vl-remove-if'(LAMBDA(x)(<(length x)2)) (xl-div pzx1234 2)) ) 
(princ) 
  )

树櫴希德 · 发表于 2019-6-26 20:09:12

本帖最后由树櫴希德于 2019-6-28 20:26 编辑

样板+样图任然有重合点望大神修改

树櫴希德 · 发表于 2019-6-25 23:25:24

我也不知道有什么用

lizhigang.jin · 发表于 2019-6-26 08:04:24

大神，给您提供一个编程的方向，就是多段线批量标注节点号（能选择每点标或隔几点标最好），并标示出点位（用点）（要修改可自己在点样式里改），同时导出对应坐标到CSV或TXT，要求支持自定义坐标（如我重新定义了某条断面的原点）。这个插件如果搞好了，非常利于做断面资料或竣工资料。谢谢！

gzxl · 发表于 2019-6-27 16:14:33

自身方格网的节点不重合就行啦，要保证方格网两个节点之间的文字不重合难。

树櫴希德 · 发表于 2019-6-28 17:52:55

批量文字插入？

(defun str1 (str num addstr / LEN STR1 STR2 pzx)
(if (< num 1) (progn (setq pzx (strcat addstr str)))
(progn
(setq len (strlen str)) ;字符长度
(setq str1 (substr str 1 num))
(setq str2 (substr str (+ num 1) (- len num)))
(setq pzx(strcat str1 addstr str2) )
)
)
pzx
)
(defun SstoEs(ss / a en lst)
(if ss(progn(setq a -1)
(while(setq en(ssname ss(setq a(1+ a))))
(setq lst(cons en lst)))))
lst)
(setq num(getint "\n请输入插入序号："))
(setq addstr(getstring "\n请输入需要插入的文字：") )
(mapcar'(lambda(x)(setq p(cdr(assoc 1(entget x)))) (setq p1(str1 p num addstr))
(entmod (subst (cons 1 p1) (assoc 1(entget x)) (entget x) ) )
) (sstoes(ssget"X"'((0 . "TEXT") ))) )

树櫴希德 · 发表于 2020-12-26 10:20:25

bgc数字转高程

;;;by Gu_xl
(defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
(regapp "SOUTH")
(setvar "CMDECHO" 0)
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" "" "")
(if height
(setq height (rtos height 2 3));3为高程注记位数
(setq height "")
)
(regapp "SOUTH")
;;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "宋体"))
;(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
(command "style" "宋体" "" 0 1 0 "" "" "")
)
;;;检查是否存在高程点图块定义
(if (not (tblobjname "block" "GC200"))
(progn
(setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
(setq obj
(vla-AddPolyline
blkdef
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 5))
'(-0.2 0 0 0.2 0 0)
)
)
)
)
(vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
)
)
;;;插入块
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
(list -3 '("SOUTH" (1000 . "202101")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "宋体")
(cons 62 3)
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 70 0)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun insertgc ( e / e)
(cdr(assoc 10(entget e)))
)
(defun insertgc11 ( e / e)
(cdr(assoc 11(entget e)))
)
(defun insert1 ( e / e)
(distof (cdr(assoc 1(entget e))) 2 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
( defun c:bgc ( / blc scale wz height zb xzb zdzb)
(setq blc (getint "\n请输入比例尺1:<500>"))
(if (= blc nil)(setq blc 500))
(setvar 'userr1 blc);设置比例尺
(setq scale (* 0.001 blc));缩放比例
(while (setq wz(car(entsel "\n请选择要转换成高程点的数字文字text:")))
(setq height (insert1 wz))
(setq zb (insertgc wz))
(setq xzb (list (+ (car zb) 1.1661) (- (cadr zb) 0.8044) height
)
);;;;;;
;(setq zdzb (getpoint "\n请指定要标注高程点的位置："))
;(setq xzb (list (car zdzb) (cadr zdzb) height ))
(gxl-cs:gcd xzb height scale)
)
)

;;;by Gu_xl 
(defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数) 
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP 
  (regapp "SOUTH") 
  (setvar "CMDECHO" 0) 
  (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "") 
  (if height 
    (setq height (rtos height 2 3));3为高程注记位数 
    (setq height "") 
  ) 
  (regapp "SOUTH") 
   
  ;;;检查字体 "HZ" 是否存在 
  (if (not (tblobjname "style" "宋体")) 
    ;(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "") 
    (command "style" "宋体" "" 0 1 0 "" "" "") 
  ) 
  ;;;检查是否存在高程点图块定义 
  (if (not (tblobjname "block" "GC200")) 
    (progn 
      (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200")) 
      (setq obj 
        (vla-AddPolyline 
           blkdef 
           (vlax-make-variant 
              (vlax-safearray-fill 
                 (vlax-make-safearray vlax-vbdouble (cons 0 5)) 
                 '(-0.2 0 0 0.2 0 0) 
              ) 
           ) 
        ) 
      ) 
      (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1) 
      (vla-put-Closed obj :vlax-true) 
      (vla-put-ConstantWidth obj 0.4) 
    ) 
  ) 
  ;;;插入块 
  (entmake (list 
             '(0 . "INSERT") 
             '(100 . "AcDbEntity") 
             '(100 . "AcDbBlockReference") 
             '(66 . 1);;;属性跟随标志,1跟随，0不跟随 
              (cons 2 "GC200") 
              (cons 10 inspt) 
              (cons 41 scale) 
              (cons 42 scale) 
              (cons 43 scale) 
              (list -3 '("SOUTH" (1000 . "202101"))) 
           ) 
  ) 
  ;;;插入属性 
  (entmake (list 
             '(0 . "ATTRIB") 
             '(100 . "AcDbEntity") 
             '(100 . "AcDbText") 
              (cons 10 (setq pt (polar inspt 0 (* 1.2 scale)))) 
              (cons 40 (* 2.0 scale)) 
              (cons 50 0) 
              (cons 41 0.8) 
              (cons 51 0) 
              (cons 1 height) 
              (cons 7 "宋体") 
       (cons 62 3) 
              (cons 72 0) 
              (cons 11 pt) 
              '(100 . "AcDbAttribute") 
              (cons 2 "height") 
              (cons 70  0) 
              (cons 74 2) 
           ) 
   ) 
   ;;;结束标志 
   (entmake '((0 . "SEQEND"))) 
   (princ) 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun insertgc ( e / e) 
  (cdr(assoc 10(entget e))) 
  ) 
(defun insertgc11 ( e / e) 
  (cdr(assoc 11(entget e))) 
  ) 
 
(defun insert1 ( e / e) 
  (distof (cdr(assoc 1(entget e))) 2 ) 
  ) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
( defun c:bgc ( /  blc scale wz height zb xzb zdzb) 
 
 
 (setq blc (getint "\n请输入比例尺1:<500>")) 
  (if (= blc nil)(setq blc 500)) 
  (setvar 'userr1 blc);设置比例尺 
(setq scale (* 0.001 blc));缩放比例 
 
  (while (setq wz(car(entsel "\n请选择要转换成高程点的数字文字text:"))) 
 
  (setq height (insert1 wz)) 
    (setq zb (insertgc wz)) 
 
    (setq xzb (list  (+ (car zb) 1.1661) (- (cadr zb) 0.8044) height 
    ) 
    );;;;;; 
   ;(setq zdzb (getpoint "\n请指定要标注高程点的位置：")) 
    ;(setq xzb  (list (car zdzb) (cadr zdzb)  height  )) 
(gxl-cs:gcd xzb height scale) 
    
   ) 
 
 
 )

账号		自动登录	找回密码
密码			注册

Cass土方5米方格网节点数字转块

本帖子中包含更多资源

相关帖子

本帖子中包含更多资源

本帖子中包含更多资源