承台高度计算
(defun c:biaogao ( / blc scale ii no ssa ssb xindian en ent ptb ptb1 pzxaa);;;;;;;;;;;;;;;;;;;;;
;选择集与对象名表互转
(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)
)
)
)
;;;;;;;;;;;;;;;;;;
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
(regapp "SOUTH")
(setq blc (getint "\n请输入比例尺1:<500>"))
(if (= blc nil)(setq blc 500))
(setvar 'userr1 blc);设置比例尺
(setq scale (* 0.001 blc));缩放比例
;;;by Gu_xl
(defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
(setvar "CMDECHO" 0)
(command "layer" "m" "bgGCD" "c" "1" "" "L" "CONTINUOUS" """")
(if height
(setq height (rtos height 2 3));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)
(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 "HZ")
(cons 62 3)
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun plinexy( e / e)
(mapcar'cdr(vl-remove-if'(lambda(x)(/=(car x)10))(entget e)))
)
(defun insertgc ( e / e)
(cdr(assoc 10(entget e)))
)
(defun poinpl(p pt);;:点是否在指定点表内
(equal(abs(apply'+(mapcar'(lambda(x y)(rem(-(angle x p)(angle y p))pi))pt(cons(last pt)pt))))pi 1e-8))
(setq ssa (ssget '((0 . "lwPOLYLINE") (8 . "0")))
ssb (ssget"X"'((0 . "insert") (8 . "gcd"))))
(setq ii 0no0pzxaa '())
(repeat (sslength ssa)
(setq en (ssname ssa ii)
ptb (plinexy en)
)
;;;;;;;;;;;;;
(foreachx (cx-ss2en ssb)
(setq ptb1 (insertgc x)
)
(if (= (poinpl ptb1 ptb) T) (progn (setq pzxaa (append pzxaa (list ptb1))) (setq no(1+ no) )
)
)
)
;;;;;;;;;;;;;;;;;;
(setq xindian (list (*(+ (car(car pzxaa)) (car(cadr pzxaa)) ) 0.5)(*(+ (cadr(car pzxaa)) (cadr(cadr pzxaa)) ) 0.5) (abs(- (caddr(car pzxaa)) (caddr(cadr pzxaa)) ) ) ))
(gxl-cs:gcd xindian (caddr xindian) scale)
(entmod(append (subst (cons 38 (caddr xindian)) (assoc 38 (entget en)) (entget en)) (list(cons 62 3))))
(setq ii(1+ ii) )
(setq pzxaa '())
(setq xindian nil)
)
;;;;;;;;;;;;(assoc 62 (subst (cons 38 (caddr xindian)) (assoc 38 (entget en)) (entget en)))
)
页:
[1]