树櫴希德 发表于 2016-4-29 20:31:11

在样本多段线中心标注高程


;;;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 vxs (e / i v lst)
(setq i 0)
(while
    (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
   (setq lst (cons v lst))
)
(reverse lst))
;;;;;;;;;;;;;;;;;;;;;;;;
(defun zxd (ent / pts len pt )
(setq pts (vxs ent))
(setq len (length pts))
(setq pt (mapcar
'(lambda(x)
    (/ x len)
)
(apply
    'mapcar
    (cons '+ pts)
)
)
      )
pt
)

(defun changdu (e / )
(Vla-get-length (VLAX-ename->vla-object e))
)
(defun changdu1 (e / )
(vlax-curve-getDistAtParam (VLAX-ename->vla-object e) (vlax-curve-getEndParam (VLAX-ename->vla-object e)));取得曲线长度
)
(defun c:ctgc (/ gczyangbenchangblc scale lst ent xinzb)

(setq gcz (getreal "\n请输入需要注记的高程值:"))
(setq yangbenchang (changdu1 (car (entsel "\n请选择样本承台LWPOLYLINE:"))))

(setq blc (getint "\n请输入比例尺1:<500>"))
(if (= blc nil)(setq blc 500))
(setvar 'userr1 blc);设置比例尺
(setq scale (* 0.001 blc));缩放比例
(setq i 0)
(setq lst (ssget '( (0 . "*polyline") (8 . "BASE,基础边")) ) )

(repeat (sslength lst)
(setq ent (ssname lst i))
(if (equal yangbenchang (changdu1 ent) 0.1)
(progn
(setq xinzb (list (car (zxd ent)) (cadr (zxd ent)) gcz ))
(gxl-cs:gcd xinzb gcz scale)
)
)

(setq i (+ i 1))
)



)




su0518 发表于 2016-5-1 11:33:00

命令是多少呀?

88641787 发表于 2016-5-6 14:33:09

如何使用   能不能演示一下
页: [1]
查看完整版本: 在样本多段线中心标注高程