- 积分
- 11672
- 明经币
- 个
- 注册时间
- 2011-9-17
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
数不清大神们的函数 有GU版等
- (gc)
- (vl-load-com)
- ;;;;;;;;;;;;;;;;;;;
- (defun str->pt (str)
- (XD::Pnt:SetZ
- (mapcar 'distof (cdr (String:Split str ",")))
- 0.
- )
- )
- ;;;;;;;;;;;
- (defun String:Split (str delimiter / post strlst stl)
- (if str
- (progn
- (setq stl (strlen delimiter))
- (while (vl-string-search delimiter str)
- (setq post (vl-string-search delimiter str)
- strlst (cons (substr str 1 post) strlst)
- str (substr str (+ 1 post stl))
- )
- )
- (reverse (vl-remove "" (cons str strlst)))
- )
- )
- )
- ;;;;;;;;;;;;;;
- (defun fast (l a / b c)
- (while l
- (if (= a (car l))
- (progn (if b
- (setq c (cons (reverse b) c)
- b nil
- )
- )
- (setq b (cons (car l) b)
- l (cdr l)
- )
- (while (and l (/= a (car l)))
- (setq b (cons (car l) b)
- l (cdr l)
- )
- )
- (setq c (cons (reverse b) c)
- b nil
- )
- )
- (progn (setq b (cons (car l) b)
- l (cdr l)
- )
- )
- )
- )
- (if b
- (setq c (cons (reverse b) c)
- b nil
- )
- )
- (reverse c)
- );;测试 (f '(2 1 3 4 5 6 2 7 8 9 2 11 13 14 2) 2) ==>'((2 1 3 4 5 6) (2 7 8 9) (2 11 13 14) (2))
- (defun gxl-cs:gcd (inspt height scale / pt pt1 blkdef obj)
- (setvar "CMDECHO" 0)
- (command "layer" "m" "检查高程点" "c" "1" "" "L" "CONTINUOUS" "" "")
- (if height
- (setq height (rtos height 2 3))
- (setq height "")
- )
-
- (regapp "SOUTH")
- ;;;检查字体 "HZ" 是否存在
- (if (not (tblobjname "style" "HZ"))
- (command "style" "HZ" "rs.shx,hztxt.shx" 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 . "202101")))
- )
- )
- ;;;插入属性
- (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 '((0 . "SEQEND")))
- (princ)
- )
- ;;;;;;;;===========================================
- (defun _List:FromFile (fn / f l ll)
- (if (setq f (open (findfile fn) "r"))
- (progn
- (while (setq l (read-line f))
- (IF (= (ASCII l)98) (progn (setq l (append (list l) (list"k") ))(setq ll (append l ll )) ) ;;(append (list "回车 \n") (list l))
- (setq ll (cons l ll ) )
- )
-
-
- )
- (close f)
- )
- )
- ( reverse(cdr(reverse (append (list"k") ll) )) ) ;(reverse(reverse ll))
- )
- ;;;;;;;;;;;;;;;
- (defun c:dmsjgcd ( / en a obj fl lst pzx blc scale pt0 Perpt LST1 ang bb len height pt1)
- (setq en (entsel "\n选择道路中心线: ") )
- (setq obj (vlax-ename->vla-object (car en)))
- (if (= nil (setq a (getreal "\n请输入起点桩号<0>:"))) (setq a 0))
-
- (setq blc (getint "\n请输入比例尺1:"))
- (setvar 'userr1 blc);设置比例尺
- ;(setq zg (* 0.002 blc));字高
- (setq scale (* 0.001 blc));缩放比例
-
- (setq fl (getfiled "Select Log file请选取南方CASS横断面数据文件:" "" "hdm" 8))
- (setq lst (_List:FromFile fl) )
- (setq pzx (mapcar '(lambda (x)(reverse(cdr x))) (fast lst "k")) ) ; (print pzx)
- (foreach x pzx
- (setq bb (distof (car(cdr (String:Split (car x) ",")) ))) ;(print (- bb a))
-
- (setq pt0 (vlax-curve-getPointAtDist obj (- bb a)) ) ;(print pt0)
-
- (setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
- LST1 (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
- ANG (atan (/ (cadr LST1) (car LST1)))
- ;pt1 (polar pt0 (+ ANG (* 0.5 pi)) len)
- ;pt2 (polar pt0 (- ANG (* 0.5 pi)) len)
- ;此处就是你画出来的是水平线的原因,变量换个方向即可 (distof(car(cdr (String:Split "begin,1040" ",")) ) ) (distof (cdr (String:Split "begin,1040" ",")))
- )
-
- (foreach y (cdr x)
- (setq len (distof (car (String:Split y ",")))) ;(print len) ;
- (setq pt1 (polar pt0 (- ANG (* 0.5 pi)) len) ) ;(print pt1)
- (setq height (distof (car(cdr (String:Split y ","))) )) ;(print height) ;;;; (distof(car (cdr (String:Split (car (cdr (car pzx))) ",")) ))
- ( gxl-cs:gcd (list (car pt1)(cadr pt1)height) height scale)
-
- )
-
- )
-
- ;(cdr (String:Split "begin,1250" ",")) (mapcar 'distof (cdr (String:Split "begin,1250" ","))) (mapcar 'distof (car (String:Split "25639,1250" ",")))
- )
测试数据:存盘为**.hdm
begin,1020
-45,12
-40,15
-35,22
-30,15
-25,3
-15,10
-8,6
0,9
3,15
16,22
26,16
33,14
45,22
begin,1040
-50,23
-45,36
-40,15
-35,20
-30,15
-25,16
-20,18
-17,22
-10,16
0,22
8,6
15,2
19,12
25,14
31,21
40,26
48,33
50,30
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|