树櫴希德大神的展点源码，高程点小数点位数想设置为3位，改了不对
;cass中一键展高程与测点(注记分开);by yuanziyou;展高程点的函数用的Gu_xl的代码:地址http://bbs.mjtd.com/forum.php?mod=viewthread&tid=96643;数据文件格式为:(点号,编码,东,北,高);明经通道:http://bbs.mjtd.com/thread-100928-1-1.html(defun c:zd()(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP(regapp "SOUTH") (regapp "NAME")(regapp "CODE")(regapp "TIME")(setq TIME(list"TIME"(cons 1000 (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD-HH:MM:SS)"))))(setq osm (getvar "osmode")) ;将"osm"的值设置为获取的当前"osmod"(捕捉模式)系统变量的值(setvar "osmode" 0) ;设置系统变量为无捕捉模式(vl-cmdf ".undo" "be")(setq blc (getint "\n请输入比例尺1:"))(setvar 'userr1 blc);设置比例尺(setq zg (* 0.002 blc));字高(setq scale (* 0.001 blc));缩放比例(setqff (open (getfiled "请选择要展点的数据文件" "" "dat" 2) "r")) (while (setq zb (read-line ff)) (while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb))) ;用空格替换"," (setq zb(read (strcat "(" zb ")")) id (nth 0 zb) ) (if (= (length zb) 5) (setq zpt (list (nth 2 zb) (nth 3 zb) (nth 4 zb)));高程与点号的插入点 (setq zpt (list (nth 1 zb) (nth 2 zb) (nth 3 zb))) ) (setq p2 (polar zpt (* 0.25 pi) (* 1.5 zg)));点号注记的插入点 (entmake (list '(0 . "POINT") (cons 10 zpt) '(8 . "ZDH") (list -3 (list "NAME"(cons 1000 (vl-princ-to-string(nth 0 zb)))) (list "CODE"(cons 1000 (vl-princ-to-string(nth 1 zb))))TIME)));展点号 (entmake (list '(0 . "TEXT") (cons 1 (vl-princ-to-string id)) (cons 10 p2) '(7 . "HZ") '(8 . "ZDH") (cons 40 zg) '(41 . 0.8)));点号注记 (gxl-cs:gcd zpt (caddr zpt) scale 2 (list "NAME"(cons 1000 (vl-princ-to-string(nth 0 zb))) (cons 1000 (vl-princ-to-string(nth 1 zb)))));展高程点 ) (close ff) (command "undo" "e")(setvar "osmode" osm) ;设置回原来的捕捉模式 (princ "展点完成")(princ));;;by Gu_xl(defun gxl-cs:gcd (inspt height scale xsws name / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)(setvar "CMDECHO" 0)(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")(if height (setq height (rtos height 2 xsws)) (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"))NAME time) ));;;插入属性(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 72 0) (cons 11 pt) '(100 . "AcDbAttribute") (cons 2 "height") (cons 700) (cons 74 2) ) ) ;;;结束标志 (entmake '((0 . "SEQEND"))) (princ))在前面加入一个小数位数的新变量【xswsa】，这样在使用时可以按需求输入小数位数。这里静默输入为6位小数。可以自己修改静默值。
后面那个xsws要修改成xswsa：
(setq height (rtos height 2 xswsa)
本帖最后由 gzxl 于 2024-7-15 15:36 编辑
没点改进，全都是搬来搬去。那是 CASS几的高程点？CASS11 的高程点分散看看。
虽然是小问题。贴一个 arx，这与 CASS11 的子图元就对应了。
/// @brief 创建Cass高程点
/// @param ptInsert : 输入插入点
/// @param strText : 输入高程值
/// @param layerName: 输入图层名(缺省为"GCD")
/// @param colorIndex : 图层颜色(缺省为红色)
/// @param dUSERR1 : 输入比例尺(缺省为500)
/// @return 成功则返回高程点的ID
AcDbObjectId CCassUtil::AddGeneralGcd(const AcGePoint3d& ptInsert,
const TCHAR* strText,
const TCHAR* layerName /*= _T("GCD") */,
int colorIndex /*= 1 */,
double dUSERR1 /*= 500 */)
{
// 获得指向块表的指针
AcDbBlockTable* pBlockTable = NULL;
acdbHostApplicationServices()->workingDatabase()->getBlockTable(pBlockTable, AcDb::kForWrite);
// 获得指向特定的块表记录(模型空间)的指针
AcDbBlockTableRecord* pBlkTblRcd = NULL;
AcDbObjectId entId = AcDbObjectId::kNull;
AcDbObjectId blkDefId = AcDbObjectId::kNull;
Acad::ErrorStatus es = pBlockTable->getAt(_T("gc200"), blkDefId);
if (!CStringUtil::IsNumOrDecimal(strText))
return AcDbObjectId::kNull;
AcGePoint3d pt(ptInsert.x, ptInsert.y, CConvertUtil::ToDouble(strText));
if (es != Acad::eOk) // GC200图块定义不存在
{
// 创建新的块表记录
pBlkTblRcd = new AcDbBlockTableRecord();
pBlkTblRcd->setName(_T("gc200"));
// 将块表记录添加到块表中
AcDbObjectId blkDefId;
pBlockTable->add(blkDefId, pBlkTblRcd);
pBlockTable->close();
AcDbObjectIdArray ObjIds;
AcGeVector3d vecNormal(0.0, 0.0, 1.0);
AcDbHatch* pHatch = new AcDbHatch();
pHatch->setNormal(vecNormal);
pHatch->setElevation(0.0);
// 将Hatch模式设置为SOLID预定义类型
pHatch->setPattern(AcDbHatch::kPreDefined, _T("SOLID"));
// 设定关联
pHatch->setAssociative(Adesk::kTrue);
AcDbObjectId circleId, hatchId;
// 圆
AcDbCircle* pCircle = new AcDbCircle(AcGePoint3d::kOrigin, vecNormal, dUSERR1 * 0.00025);
pBlkTblRcd->appendAcDbEntity(circleId, pCircle);
pCircle->close();
ObjIds.append(circleId);
// 填充
pHatch->appendLoop(AcDbHatch::kDefault, ObjIds);
pHatch->evaluateHatch();
ObjIds.setLogicalLength(0);
pHatch->getAssocObjIds(ObjIds);
pBlkTblRcd->appendAcDbEntity(hatchId, pHatch);
pHatch->close();
pBlkTblRcd->close();
}
pBlockTable->getAt(ACDB_MODEL_SPACE, pBlkTblRcd, AcDb::kForWrite);
es = pBlockTable->getAt(_T("gc200"), blkDefId);
if (es != Acad::eOk)
return AcDbObjectId::kNull;
// 创建新图层并设置当前层
CLayerUtil::Add(layerName, colorIndex);
CLayerUtil::SetCurLayer(layerName);
// 定义块参数参数
AcDbBlockReference* pBlockRef = new AcDbBlockReference(pt, blkDefId);
pBlockRef->setLayer(layerName);
AcGeScale3d Scale3d(dUSERR1 * 0.001, dUSERR1 * 0.001, dUSERR1 * 0.001);
pBlockRef->setScaleFactors(Scale3d);
AcGePoint3d positionPt, alignmentPt;
positionPt = CGePointUtil::PolarPoint(pt, 0.0, dUSERR1 * 0.0012);
alignmentPt = CGePointUtil::PolarPoint(positionPt, CMathUtil::PI() * 1.5, dUSERR1 * 0.001);
// 字体
CString simhei = _T("等线体");
AcDbObjectId simheiId = CTextStyleUtil::GetAt(simhei);
if (simheiId.isNull())
CTextStyleUtil::Add(simhei, _T("simhei.ttf"), _T("常规"));
// 设置当前字体
CTextStyleUtil::SetCurTextStyle(_T("等线体"));
// 块属性定义参数
AcDbAttribute* pAttribute = new AcDbAttribute(pt, strText, _T("height"), simheiId);
pAttribute->setHeight(dUSERR1 * 0.002);
pAttribute->setWidthFactor(0.8);
pBlockRef->appendAttribute(pAttribute);
pAttribute->setHorizontalMode(AcDb::kTextLeft); // 左对齐
pAttribute->setVerticalMode(AcDb::kTextVertMid);// 左中
pAttribute->setPosition(alignmentPt); // 文本的位置点
pAttribute->setAlignmentPoint(positionPt); // 对齐点
pAttribute->setLayer(layerName);
pAttribute->setColorIndex(colorIndex);
// 创建扩展数据
struct resbuf* pRb;
pRb = acutBuildList(AcDb::kDxfRegAppName, _T("SOUTH"), AcDb::kDxfXdAsciiString, _T("202101"), RTNONE);
acdbRegApp(_T("SOUTH"));
pBlockRef->setXData(pRb);
acutRelRb(pRb);
pBlkTblRcd->appendAcDbEntity(entId, pBlockRef);
// 关闭对象
pAttribute->close();
pBlockRef->close();
pBlockTable->close();
pBlkTblRcd->close();
// 返回
return entId;
}
;cass中一键展高程与测点(注记分开)
;by yuanziyou
;展高程点的函数用的Gu_xl的代码:地址http://bbs.mjtd.com/forum.php?mod=viewthread&tid=96643
;数据文件格式为:(点号,编码,东,北,高)
;明经通道:http://bbs.mjtd.com/thread-100928-1-1.html
(defun c:zd()
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
(regapp "SOUTH")
(regapp "NAME")
(regapp "CODE")
(regapp "TIME")
(setq TIME(list"TIME"(cons 1000 (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD-HH:MM:SS)"))))
(setq osm (getvar "osmode")) ;将"osm"的值设置为获取的当前"osmod"(捕捉模式)系统变量的值
(setvar "osmode" 0) ;设置系统变量为无捕捉模式
(vl-cmdf ".undo" "be")
(setq blc (getint "\n请输入比例尺1:"))
(setvar 'userr1 blc);设置比例尺
(setq zg (* 0.002 blc));字高
(setq scale (* 0.001 blc));缩放比例
(setqff (open (getfiled "请选择要展点的数据文件" "" "dat" 2) "r"))
(while (setq zb (read-line ff))
(while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb))) ;用空格替换","
(setq zb(read (strcat "(" zb ")"))
id (nth 0 zb)
)
(if (= (length zb) 5)
(setq zpt (list (nth 2 zb) (nth 3 zb) (nth 4 zb)));高程与点号的插入点
(setq zpt (list (nth 1 zb) (nth 2 zb) (nth 3 zb)))
)
(setq p2 (polar zpt (* 0.25 pi) (* 1.5 zg)));点号注记的插入点
(entmake (list '(0 . "POINT") (cons 10 zpt) '(8 . "ZDH")
(list -3 (list "NAME"(cons 1000 (vl-princ-to-string(nth 0 zb))))
(list "CODE"(cons 1000 (vl-princ-to-string(nth 1 zb))))TIME)));展点号
(entmake (list '(0 . "TEXT") (cons 1 (vl-princ-to-string id)) (cons 10 p2) '(7 . "HZ") '(8 . "ZDH") (cons 40 zg) '(41 . 0.8)));点号注记
(gxl-cs:gcd zpt (caddr zpt) scale 2 (list "NAME"(cons 1000 (vl-princ-to-string(nth 0 zb)))
(cons 1000 (vl-princ-to-string(nth 1 zb)))));展高程点
)
(close ff)
(command "undo" "e")
(setvar "osmode" osm) ;设置回原来的捕捉模式
(princ "展点完成")
(princ)
)
;;;by Gu_xl
(defun gxl-cs:gcd (inspt height scale xsws name / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
(setvar "CMDECHO" 0)
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")
(if height
(setq height (rtos height 2 xsws))
(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"))NAME time)
)
)
;;;插入属性
(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 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
cjf160204 发表于 2024-7-15 11:14
;cass中一键展高程与测点(注记分开)
;by yuanziyou
;展高程点的函数用的Gu_xl的代码:地址http://bbs.mjtd ...
高程点小数点位数，设置为展点数据为几位就几位 (defun gxl-cs:gcd (inspt height scale xsws name / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数) 修改xsws啊 hao3ren 发表于 2024-7-15 12:17
(defun gxl-cs:gcd (inspt height scale xsws name / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高 ...
修改了，不能正常显示 (setq height (rtos height 2 xsws))
直接把xsws修改成你想要的数字 煮茗 发表于 2024-7-31 21:37
在前面加入一个小数位数的新变量【xswsa】，这样在使用时可以按需求输入小数位数。这里静默输入为6位 ...
谢谢可以了 cjf160204 发表于 2024-7-31 22:51
谢谢可以了
;cass中一键展高程与测点(注记分开)
(defun c:zd()
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
(regapp "SOUTH")
(regapp "NAME")
(regapp "CODE")
(regapp "TIME")
(setq TIME(list"TIME"(cons 1000 (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD-HH:MM:SS)"))))
(setq osm (getvar "osmode")) ;将"osm"的值设置为获取的当前"osmod"(捕捉模式)系统变量的值
(setvar "osmode" 0) ;设置系统变量为无捕捉模式
(vl-cmdf ".undo" "be")
(setq blc (getint "\n请输入比例尺1:"))
(setvar 'userr1 blc);设置比例尺
(setq zg (* 0.002 blc));字高
(setq scale (* 0.001 blc));缩放比例
(setq xswsa (getint "\n请输入展点高程小数位数:<6>"))
(if (null xswsa)(setq xswsa 6))
(setqff (open (getfiled "请选择要展点的数据文件" "" "dat" 2) "r"))
(while (setq zb (read-line ff))
(while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb))) ;用空格替换","
(setq zb(read (strcat "(" zb ")"))
id (nth 0 zb)
)
(if (= (length zb) 5)
(setq zpt (list (nth 2 zb) (nth 3 zb) (nth 4 zb)));高程与点号的插入点
(setq zpt (list (nth 1 zb) (nth 2 zb) (nth 3 zb)))
)
(setq p2 (polar zpt (* 0.25 pi) (* 1.5 zg)));点号注记的插入点
(entmake (list '(0 . "POINT") (cons 10 zpt) '(8 . "ZDH")
(list -3 (list "NAME"(cons 1000 (vl-princ-to-string(nth 0 zb))))
(list "CODE"(cons 1000 (vl-princ-to-string(nth 1 zb))))TIME)));展点号
(entmake (list '(0 . "TEXT") (cons 1 (vl-princ-to-string id)) (cons 10 p2) '(7 . "HZ") '(8 . "ZDH") (cons 40 zg) '(41 . 0.8)));点号注记
(gxl-cs:gcd zpt (caddr zpt) scale 2 (list "NAME"(cons 1000 (vl-princ-to-string(nth 0 zb)))
(cons 1000 (vl-princ-to-string(nth 1 zb)))));展高程点
)
(close ff)
(command "undo" "e")
(setvar "osmode" osm) ;设置回原来的捕捉模式
(princ "展点完成")
(princ)
)
;;;by Gu_xl
(defun gxl-cs:gcd (inspt height scale xsws name / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
(setvar "CMDECHO" 0)
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")
(if height
(setq height (rtos height 2 xswsa))
(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"))NAME time)
)
)
;;;插入属性
(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 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
页:
[1]
2