生成的高程不显示注记
(defun c:xsgcd (/ os oldcmd ss p1 p1z p2 p2z pline dist totalDist n i param pt newZ entData newEnt)(vl-load-com)
(setq os (getvar "osmode")
oldcmd (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(princ "\n选择两个高程点: ")
(setq ss (ssget '((0 . "INSERT") (2 . "gc*"))))
(if (or (null ss) (/= (sslength ss) 2))
(progn (alert "必须选择两个高程点!") (exit))
)
(setq entData (entget (ssname ss 0))
p1 (cdr (assoc 10 entData))
p1z (caddr p1)
p2 (cdr (assoc 10 (entget (ssname ss 1))))
p2z (caddr p2))
(setq pline (car (entsel "\n选择多段线: ")))
(if (not (wcmatch (cdr (assoc 0 (entget pline))) "*POLYLINE"))
(progn (alert "必须选择多段线!") (exit))
)
(initget 7)
(setq dist (getdist "\n高程点间距: "))
(setq totalDist (vlax-curve-getDistAtParam pline (vlax-curve-getEndParam pline))
n (fix (/ totalDist dist)))
(if (<= n 0) (progn (alert "间距过大或线段过短!") (exit)))
(setq i 0)
(repeat n
(setq param (vlax-curve-getParamAtDist pline (* dist (setq i (1+ i))))
pt (vlax-curve-getPointAtParam pline param)
newZ (+ p1z (* (/ (vlax-curve-getDistAtPoint pline pt) totalDist) (- p2z p1z))))
(setq newEnt
(list
'(0 . "INSERT")
(cons 2 (cdr (assoc 2 entData)))
(cons 10 (list (car pt) (cadr pt) newZ))
(cons 41 0.5) (cons 42 0.5) (cons 43 0.5)
(cons 8 "GCD") ; 图层
(list -3
(list "SOUTH" (cons 1000 "202101"))
(list "S_GXRQ" (cons 1071 1754994397))
)
)
)
(entmake newEnt)
)
(setvar "osmode" os)
(setvar "cmdecho" oldcmd)
(princ (strcat "\n成功生成 " (itoa n) " 个高程点"))
(princ)
)
大哥们帮忙看一下，为什么生成的高程点只有一个圆点。没有注记呢？生成的高程点没有height属性。
这个程序不完整，好像需要修复了 czb203 发表于 2025-8-13 10:56
这个程序不完整，好像需要修复了
嗯嗯，错误肯定是有的。实在是研究不出来了！ CASS 高程点是个属性块，顾版的有个生成CASS 高程点lisp源码 gzxl 发表于 2025-8-13 11:25
CASS 高程点是个属性块，顾版的有个生成CASS 高程点lisp源码
好的 我找一下！ (defun c:xsgcd (/ os oldcmd ss p1 p1z p2 p2z pline dist totalDist n i param pt newZ entData blkName attData attHeight)
(vl-load-com)
(setq os (getvar "osmode")
oldcmd (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(princ "\n选择两个高程点: ")
(setq ss (ssget '((0 . "INSERT") (2 . "gc*"))))
(if (or (null ss) (/= (sslength ss) 2))
(progn (alert "必须选择两个高程点!") (exit))
)
(setq entData (entget (ssname ss 0))
p1 (cdr (assoc 10 entData))
p1z (caddr p1)
blkName (cdr (assoc 2 entData)); 获取块名
)
(setq attData (entnext (ssname ss 0)))
(setq attData (entget attData))
(setq attHeight (cdr (assoc 40 attData)))
(setq attTag (cdr (assoc 2 attData)))
(setq p2 (cdr (assoc 10 (entget (ssname ss 1)))))
(setq p2z (caddr p2))
(setq pline (car (entsel "\n选择多段线: ")))
(if (not (wcmatch (cdr (assoc 0 (entget pline))) "*POLYLINE"))
(progn (alert "必须选择多段线!") (exit))
)
(initget 7)
(setq dist (getdist "\n高程点间距: "))
(setq totalDist (vlax-curve-getDistAtParam pline (vlax-curve-getEndParam pline))
n (fix (/ totalDist dist)))
(if (<= n 0) (progn (alert "间距过大或线段过短!") (exit)))
(setq i 0)
(repeat n
(setq param (vlax-curve-getParamAtDist pline (* dist (setq i (1+ i))))
pt (vlax-curve-getPointAtParam pline param)
newZ (+ p1z (* (/ (vlax-curve-getDistAtPoint pline pt) totalDist) (- p2z p1z)))
)
; 创建块参照
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1)
(cons 2 "GC200")
(cons 10 (list (car pt) (cadr pt) newZ))
(cons 41 0.5)
(cons 42 0.5)
(cons 43 0.5)
'(-3 ("SOUTH" (1000 . "202101")))
)
)
; 创建属性（高程值）
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (polar pt 0 (* 1.2 0.5)))
(cons 40 attHeight)
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 (rtos newZ 2 2))
(cons 7 "HZ")
(cons 72 0)
(cons 11 (polar pt 0 (* 1.2 0.5)))
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
; 结束属性序列
(entmake '((0 . "SEQEND")))
)
(setvar "osmode" os)
(setvar "cmdecho" oldcmd)
(princ (strcat "\n成功生成 " (itoa n) " 个高程点"))
(princ)
)
使用了顾版的CASS高程点生成代码中的创建块参照和创建属性（高程值）一下就好了！ zyx1029 发表于 2025-8-13 12:39
使用了顾版的CASS高程点生成代码中的创建块参照和创建属性（高程值）一下就好了！
谢谢分享，点赞 lxl217114 发表于 2025-8-14 08:53
谢谢分享，点赞
创建块参照中加图层(cons 8 "GCD");忘记弄这个了
页:
[1]