Cass土方5米方格网节点数字转块
本帖最后由 树櫴希德 于 2019-7-1 20:26 编辑;;name:BF-list-delsame
;;;desc:删除表中相同元素，保留第一次出现的位置
;;;arg:lst:列表
;;;arg:buzz:容差
;;;return:删除重复元素组成的表
;;;example:(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 (appendx (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-1height-2 scale/ ptpt1 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 700)
(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 700)
(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 700)
(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-28 20:26 编辑
样板+样图 任然有重合点 望大神修改
我也不知道有什么用
大神，给您提供一个编程的方向，就是多段线批量标注节点号（能选择每点标或隔几点标最好），并标示出点位（用点）（要修改可自己在点样式里改），同时导出对应坐标到CSV或TXT，要求支持自定义坐标（如我重新定义了某条断面的原点）。这个插件如果搞好了，非常利于做断面资料或竣工资料。谢谢！ 自身方格网的节点不重合就行啦，要保证方格网两个节点之间的文字不重合难。
批量文字插入？
(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") ))) )
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 700)
(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)
)
)
页:
[1]