List 语言:set和setq差别

本文深入探讨了Lisp编程语言中setq和set函数的使用方法及区别,尤其强调了setq函数的高级特性,如同时对多个变量进行赋值,并通过实例演示了如何高效地在Lisp环境中进行变量赋值。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

在Lisp中,如果我们希望对一个变量赋值,可以使用set函数,用法如下:

(set ‘my-value "my string")

上面的代码是对变量my-value进行赋值,值是"my String"。注意其中的'my-value前面是有一个单引号的。

 

我们知道,在Lisp中,'my-value其实是(quote my-value)的简写,所以上面的set函数代码也可以写成这样:

(set (quote my-value) "my string")


不过,因为set函数使用的次数很多,每次都要使用quote或者在变量名前加一个单引号比较麻烦,于是发展了setq函数,setq中的q字母就是代表quote的意思,使用setq函数就可以这样写了:

(setq my-value "my string")

上面的代码也是对变量my-value进行赋值,值是"my String",是不是比set函数好用一点?

 

如果只是这样使用,可以认为set和setq是没有差别的,只是格式不同。

但是,事实上setq比set函数要高级一些,setq函数还可以同时对多个变量进行赋值,像下面这样:

(setq my-value1 "my string 1" my-value2 "my string 2")

上面的代码同时对变量my-value1和my-value2进行赋值。

 

而set函数就不能这样使用了。

;;; 曲面展开放样工具 v3.2 - 完整优化版 ;;; 支持圆柱面、圆锥面、直纹曲面样条曲面的展开 (defun c:ZKK () (vl-load-com) ; 加载Visual LISP扩展 (princ "\n曲面展开放样工具 v3.2 - 完整优化版") (setq startTime (getvar "TDUSRTIMER")) ; 记录开始时间 ;; 用户选择曲面实体 (setq ent (car (entsel "\n选择曲面实体: "))) (if (null ent) (princ "\n未选择对象") (progn ;; 获取实体类型 (setq objType (cdr (assoc 0 (entget ent)))) ;; 获取分段参数 (initget 7) ; 禁止空输入 (setq uSteps (cond ((getint "\nU向分段数 (1-100) <20>: ")) (20))) (initget 7) (setq vSteps (cond ((getint "\nV向分段数 (1-50) <10>: ")) (10))) ;; 验证分段数范围 (if (or (< uSteps 1) (> uSteps 100)) (setq uSteps 20)) (if (or (< vSteps 1) (> vSteps 50)) (setq vSteps 10)) ;; 获取曲面参数 (setq params (getSurfaceParams ent objType)) (if params (progn ;; 创建参数化网格 (setq pt3DGrid (createParametricGrid params uSteps vSteps)) (if pt3DGrid (progn ;; 展开曲面为2D平面 (setq pt2DGrid (unfoldSurface params pt3DGrid uSteps vSteps)) ;; 生成展开网格 (setq faceList (generateUnfoldedMesh pt2DGrid uSteps vSteps)) (if faceList (progn ;; 绘制展开图 (drawUnfoldedSurface faceList) ;; 计算并显示曲面面积 (setq area (calculateSurfaceArea pt3DGrid uSteps vSteps)) (princ (strcat "\n成功展开曲面!\n" "展开面积: " (rtos area 2 2) " 平方单位\n" "分段设置: U=" (itoa uSteps) ", V=" (itoa vSteps) "\n" "耗时: " (rtos (- (getvar "TDUSRTIMER") startTime) 2 2) " 秒")) ) (princ "\n错误:无法生成展开网格") ) ) (princ "\n错误:无法创建参数化网格") ) ) (princ "\n不支持的曲面类型") ) ) ) (princ) ) ;;; 获取曲面参数 (defun getSurfaceParams (ent objType) (setq obj (vlax-ename->vla-object ent)) (setq objName (vla-get-objectname obj)) (cond ((wcmatch objName "*Cylinder") ; 圆柱面 (list 'cylinder obj)) ((wcmatch objName "*Cone") ; 圆锥面 (list 'cone obj)) ((wcmatch objName "*RuledSurface") ; 直纹曲面 (list 'ruled obj)) ((wcmatch objName "*SplineSurface") ; 样条曲面 (list 'spline obj)) (t nil) ) ) ;;; 创建参数化网格 (defun createParametricGrid (params uSteps vSteps) (if (not (and (listp params) (> (length params) 1))) (progn (princ "\n错误:曲面参数无效") nil ) (progn (setq ptGrid '()) (setq du (/ 1.0 (float uSteps))) (setq dv (/ 1.0 (float vSteps))) ;; 遍历U方向 (setq i 0) (repeat (1+ uSteps) (setq u (* (float i) du)) (setq vList '()) ;; 遍历V方向 (setq j 0) (repeat (1+ vSteps) (setq v (* (float j) dv)) (setq pt (evaluateSurface params u v)) ; 曲面求值 (setq vList (cons pt vList)) (setq j (1+ j)) ) (setq ptGrid (cons (reverse vList) ptGrid)) (setq i (1+ i)) ) (reverse ptGrid) ; 返回网格点阵 ) ) ) ;;; 曲面求值函数 (defun evaluateSurface (params u v) (cond ;; 圆柱面求值 ((eq (car params) 'cylinder) (setq obj (cadr params)) (setq rad (vla-get-radius obj)) (setq height (vla-get-height obj)) (setq ang (* u 2.0 pi)) (list (* rad (cos ang)) (* rad (sin ang)) (* v height) ) ) ;; 圆锥面求值 ((eq (car params) 'cone) (setq obj (cadr params)) (setq baseRad (vla-get-radius obj)) (setq height (vla-get-height obj)) (setq topRad (vla-get-topradius obj)) (setq rad (+ baseRad (* v (- topRad baseRad)))) (setq ang (* u 2.0 pi)) (list (* rad (cos ang)) (* rad (sin ang)) (* v height) ) ) ;; 直纹曲面求值 ((eq (car params) 'ruled) (setq obj (cadr params)) (setq curve1 (vla-get-curve1 obj)) (setq curve2 (vla-get-curve2 obj)) (if (and curve1 curve2) (progn (setq pt1 (vlax-curve-getPointAtParam curve1 u)) (setq pt2 (vlax-curve-getPointAtParam curve2 u)) (if (and pt1 pt2) (list (+ (car pt1) (* v (- (car pt2) (car pt1)))) (+ (cadr pt1) (* v (- (cadr pt2) (cadr pt1)))) (+ (caddr pt1) (* v (- (caddr pt2) (caddr pt1)))) ) (list 0.0 0.0 0.0) ) ) (list 0.0 0.0 0.0) ) ) ;; 样条曲面求值 ((eq (car params) 'spline) (setq obj (cadr params)) (if (vlax-method-applicable-p obj 'Evaluate) (vlax-invoke obj 'Evaluate u v) (progn ;; 样条曲面回退方法 (princ "\n警告:使用近似方法处理样条曲面") (approxSplineSurface obj u v) ) ) ) (t (list 0.0 0.0 0.0)) ) ) ;;; 样条曲面近似方法 (defun approxSplineSurface (obj u v) (setq uPoints 10) (setq vPoints 10) (setq uStep (/ 1.0 uPoints)) (setq vStep (/ 1.0 vPoints)) ;; 查找最近的已知点 (setq nearestU (* (fix (/ u uStep)) uStep)) (setq nearestV (* (fix (/ v vStep)) vStep)) ;; 获取四个最近点 (setq p1 (vlax-invoke obj 'Evaluate nearestU nearestV)) (setq p2 (vlax-invoke obj 'Evaluate (+ nearestU uStep) nearestV)) (setq p3 (vlax-invoke obj 'Evaluate nearestU (+ nearestV vStep))) (setq p4 (vlax-invoke obj 'Evaluate (+ nearestU uStep) (+ nearestV vStep))) ;; 双线性插值 (setq uRatio (/ (- u nearestU) uStep)) (setq vRatio (/ (- v nearestV) vStep)) (list (+ (car p1) (* uRatio (- (car p2) (car p1))) (* vRatio (- (car p3) (car p1))) (* uRatio vRatio (+ (car p1) (- (car p4)) (car p2) (car p3)))) (+ (cadr p1) (* uRatio (- (cadr p2) (cadr p1))) (* vRatio (- (cadr p3) (cadr p1))) (* uRatio vRatio (+ (cadr p1) (- (cadr p4)) (cadr p2) (cadr p3)))) (+ (caddr p1) (* uRatio (- (caddr p2) (caddr p1))) (* vRatio (- (caddr p3) (caddr p1))) (* uRatio vRatio (+ (caddr p1) (- (caddr p4)) (caddr p2) (caddr p3)))) ) ) ;;; 曲面展开函数 (defun unfoldSurface (params pt3DGrid uSteps vSteps) (cond ((eq (car params) 'cylinder) (unfoldCylinder pt3DGrid uSteps vSteps)) ((eq (car params) 'cone) (unfoldCone pt3DGrid uSteps vSteps)) ((eq (car params) 'ruled) (unfoldRuledSurface pt3DGrid uSteps vSteps)) (t (princ "\n警告:此曲面类型使用平面近似展开") pt3DGrid) ) ) ;;; 圆柱面展开实现 (defun unfoldCylinder (ptGrid uSteps vSteps) (setq radius (distance '(0 0 0) (car (car ptGrid)))) (setq unfolded '()) (setq i 0) ;; 遍历U方向 (repeat (1+ uSteps) (setq vList '()) (setq baseZ (caddr (car (nth i ptGrid)))) (setq prevAng nil) (setq j 0) ;; 遍历V方向 (repeat (1+ vSteps) (setq pt (nth j (nth i ptGrid))) (setq ang (atan (cadr pt) (car pt))) ;; 处理角度跨越0点的情况 (if (and prevAng (> (abs (- ang prevAng)) pi)) (if (> ang prevAng) (setq ang (- ang (* 2 pi))) (setq ang (+ ang (* 2 pi))) ) ) (setq prevAng ang) (setq arcLength (* radius ang)) ; 弧长 = 半径 × 角度 (setq height (- (caddr pt) baseZ)) (setq vList (cons (list arcLength height 0) vList)) (setq j (1+ j)) ) (setq unfolded (cons (reverse vList) unfolded)) (setq i (1+ i)) ) (reverse unfolded) ) ;;; 圆锥面展开实现 (defun unfoldCone (ptGrid uSteps vSteps) (setq baseRadius (distance '(0 0 0) (car (car ptGrid)))) (setq topRadius (distance '(0 0 0) (car (last ptGrid)))) (setq height (caddr (car (last ptGrid)))) (setq unfolded '()) ;; 计算展开扇形参数 (setq slantHeight (sqrt (+ (expt (- baseRadius topRadius) 2) (expt height 2)))) (setq fullAngle (* 2 pi baseRadius slantHeight)) (setq i 0) (repeat (1+ uSteps) (setq vList '()) (setq baseZ (caddr (car (nth i ptGrid)))) (setq uAngle (* fullAngle (/ i uSteps))) (setq j 0) (repeat (1+ vSteps) (setq pt (nth j (nth i ptGrid))) (setq currentRadius (distance '(0 0 0) (list (car pt) (cadr pt) 0))) (setq vFraction (/ j vSteps)) ;; 计算展开点坐标 (setq currentSlantHeight (* slantHeight (- 1 (* vFraction (/ (- baseRadius topRadius) baseRadius))))) (setq x (* currentSlantHeight (cos uAngle))) (setq y (* currentSlantHeight (sin uAngle))) (setq vList (cons (list x y 0) vList)) (setq j (1+ j)) ) (setq unfolded (cons (reverse vList) unfolded)) (setq i (1+ i)) ) (reverse unfolded) ) ;;; 直纹曲面展开实现 (defun unfoldRuledSurface (ptGrid uSteps vSteps) (setq unfolded '()) (setq basePoints (car ptGrid)) ;; 计算基准曲线长度 (setq baseLength 0.0) (setq i 0) (repeat uSteps (setq p1 (nth i (car ptGrid))) (setq p2 (nth (1+ i) (car ptGrid))) (setq baseLength (+ baseLength (distance p1 p2))) (setq i (1+ i)) ) (setq i 0) (repeat (1+ uSteps) (setq vList '()) (setq currentPoint (nth i (car ptGrid))) (setq cumulativeLength 0.0) ;; 计算沿基准曲线的累计长度 (if (> i 0) (progn (setq k 0) (repeat i (setq p1 (nth k (car ptGrid))) (setq p2 (nth (1+ k) (car ptGrid))) (setq cumulativeLength (+ cumulativeLength (distance p1 p2))) (setq k (1+ k)) ) ) ) (setq j 0) (repeat (1+ vSteps) (setq pt (nth j (nth i ptGrid))) ;; 计算展开点坐标 (setq x cumulativeLength) (setq y (distance currentPoint pt)) (setq vList (cons (list x y 0) vList)) (setq j (1+ j)) ) (setq unfolded (cons (reverse vList) unfolded)) (setq i (1+ i)) ) (reverse unfolded) ) ;;; 生成展开网格 (defun generateUnfoldedMesh (ptGrid uSteps vSteps) (if (or (null ptGrid) (/= (length ptGrid) (1+ uSteps))) (progn (princ "\n错误:参数化网格结构无效") nil ) (progn (setq faces '()) (setq ptIndex '()) ; 使用关联列表代替哈希表 ;; 遍历所有点并去重 (setq i 0) (while (<= i uSteps) (setq j 0) (while (<= j vSteps) (setq pt (nth j (nth i ptGrid))) (setq key (strcat (rtos (car pt) 2 6) "," (rtos (cadr pt) 2 6) "," (rtos (caddr pt) 2 6))) (if (not (assoc key ptIndex)) ; 检查键是否已存在 (setq ptIndex (cons (cons key pt) ptIndex)) ) (setq j (1+ j)) ) (setq i (1+ i)) ) ;; 生成三角面片 (setq faces '()) (setq i 0) (while (< i uSteps) (setq j 0) (while (< j vSteps) (setq p1 (nth j (nth i ptGrid))) (setq p2 (nth j (nth (1+ i) ptGrid))) (setq p3 (nth (1+ j) (nth (1+ i) ptGrid))) (setq p4 (nth (1+ j) (nth i ptGrid))) ;; 创建两个三角形面片 (setq faces (cons (list p1 p2 p4) faces)) (setq faces (cons (list p2 p3 p4) faces)) (setq j (1+ j)) ) (setq i (1+ i)) ) (princ (strcat "\n网格优化: 共处理 " (itoa (length ptIndex)) " 个唯一顶点")) faces ; 返回面片列表 ) ) ) ;;; 绘制展开图 (defun drawUnfoldedSurface (faces) (if (null faces) (princ "\n错误:未生成有效的展开面") (progn ;; 创建新图层 (setq layerName "Surface_Unfolded") (if (not (tblsearch "LAYER" layerName)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 layerName) '(70 . 0) '(62 . 1) '(6 . "Continuous")) ) ) (setvar "CLAYER" layerName) ;; 绘制所有三角面片 (foreach face faces (entmakex (list '(0 . "3DFACE") (cons 10 (car face)) ; 第一个点 (cons 11 (cadr face)) ; 第二个点 (cons 12 (caddr face)) ; 第三个点 (cons 13 (caddr face)) ; 重复第三个点作为第四个点 ) ) ) ;; 添加尺寸标注 (addDimensioning faces) ) ) ) ;;; 添加尺寸标注 (defun addDimensioning (faces) (if faces (progn (setq minX 1e99 maxX -1e99 minY 1e99 maxY -1e99) ;; 计算展开图的边界 (foreach face faces (foreach pt (list (car face) (cadr face) (caddr face)) (if (< (car pt) minX) (setq minX (car pt))) (if (> (car pt) maxX) (setq maxX (car pt))) (if (< (cadr pt) minY) (setq minY (cadr pt))) (if (> (cadr pt) maxY) (setq maxY (cadr pt))) ) ) ;; 绘制边界框 (setq p1 (list minX minY 0)) (setq p2 (list maxX minY 0)) (setq p3 (list maxX maxY 0)) (setq p4 (list minX maxY 0)) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 p1) (cons 10 p2) (cons 10 p3) (cons 10 p4))) ;; 添加尺寸标注 (setq dimLayer "Dimensions") (if (not (tblsearch "LAYER" dimLayer)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 dimLayer) '(70 . 0) '(62 . 2) '(6 . "Continuous")) ) ) (setvar "CLAYER" dimLayer) ;; 水平尺寸 (setq dimPt (list minX (- minY (* (- maxY minY) 0.1)) 0)) (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 dimPt) ; 尺寸线位置 (cons 11 (list (/ (+ minX maxX) 2.0) (- minY (* (- maxY minY) 0.15)) 0)) ; 文字位置 (cons 1 "") ; 文字内容 '(70 . 32) ; 水平尺寸 (cons 13 p1) ; 起点 (cons 14 p2) ; 终点 '(1 . "") '(3 . "STANDARD") )) ;; 垂直尺寸 (setq dimPt (list (- minX (* (- maxX minX) 0.1)) minY 0)) (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 dimPt) ; 尺寸线位置 (cons 11 (list (- minX (* (- maxX minX) 0.15)) (/ (+ minY maxY) 2.0) 0)) ; 文字位置 (cons 1 "") ; 文字内容 '(70 . 0) ; 垂直尺寸 (cons 13 p1) ; 起点 (cons 14 p4) ; 终点 '(1 . "") '(3 . "STANDARD") )) ) ) ) ;;; 计算曲面面积 (defun calculateSurfaceArea (ptGrid uSteps vSteps) (if (or (null ptGrid) (/= (length ptGrid) (1+ uSteps))) (progn (princ "\n错误:参数化网格结构无效") 0.0 ) (progn (setq area 0.0) (setq i 0) (while (< i uSteps) (setq j 0) (while (< j vSteps) (setq p1 (nth j (nth i ptGrid))) (setq p2 (nth j (nth (1+ i) ptGrid))) (setq p3 (nth (1+ j) (nth (1+ i) ptGrid))) (setq p4 (nth (1+ j) (nth i ptGrid))) ;; 计算两个三角形面积 (setq area (+ area (triangleArea p1 p2 p4) (triangleArea p2 p3 p4) )) (setq j (1+ j)) ) (setq i (1+ i)) ) area ; 返回总面积 ) ) ) ;;; 计算三角形面积 (defun triangleArea (p1 p2 p3) (if (or (null p1) (null p2) (null p3)) 0.0 (progn (setq a (distance p1 p2)) (setq b (distance p2 p3)) (setq c (distance p3 p1)) (setq s (/ (+ a b c) 2.0)) (sqrt (abs (* s (- s a) (- s b) (- s c)))) ) ) ) ;;; 启动消息 (defun start-message () (princ "\n曲面展开命令 ZKK 已加载\n使用方法: 在命令行输入 ZKK 并按提示操作") (princ "\n支持类型: 圆柱面、圆锥面、直纹曲面、样条曲面") (princ "\n优化特性: 顶点去重、性能计时、参数范围限制、自动尺寸标注") (princ) ) ;; 初始化 (start-message) 优化代码,添加识别样条曲面类型(拉伸)
07-18
(defun c:ModifyBlockElevationAll (/ *error* mode ss blocks polyList ptList totalBlocks modifiedBlocks skippedBlocks nonNumericBlocks deltaValue blockName atts att attrFound oldValue numValue newValue ent i polyObj minPt insideBlocks coords j pt poly inside insPt newZ entData closedFlag nextEnt vertexData acadApp activeDoc selSet blockObj minX maxX minY maxY expand bbox polyData regions regionSpace ptInside useRayCasting region result) ; 错误处理函数 (defun *error* (msg) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n错误: " msg)) ) ; 清理区域对象 (if regions (foreach r regions (if (and r (not (vlax-erased-p r)) (vla-delete r) ) ) ) (setvar 'cmdecho 1) (princ) ) ; 高效的点是否在多边形内部函数 (射线法) (defun PointInsidePolygon (pt poly / x y n i j xi yi xj yj intersect) (setq x (car pt) y (cadr pt)) (set极 n (length poly)) (setq i 0 j (1- n)) (setq intersect nil) (repeat n (setq xi (car (nth i poly))) (setq yi (cadr (nth i poly))) (setq xj (car (nth j poly))) (setq yj (cadr (nth j poly))) (if (and (or (and (<= yi y) (< yj y)) (and (<= yj y) (< yi y))) (< x (+ xi (/ (* (- xj xi) (- y yi)) (- yj yi))))) (setq intersect (not intersect)) ) (setq j i) (setq i (1+ i)) ) intersect ) ; 创建区域对象用于精确点包含检测 (defun CreateRegionFromPoly (ent) (if ent (progn (setq regionSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (if regionSpace (progn (setq region (vl-catch-all-apply 'vla-AddRegion (list regionSpace (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject '(0 . 0)) (list ent))))) (if (and (not (vl-catch-all-error-p region)) region) region nil ) ) nil ) ) nil ) ) ; 使用区域对象检测点是否在多边形内 (defun PointInRegion (pt region) (if region (progn (setq result (vl-catch-all-apply 'vla-GetPointContainment (list region (vlax-3d-point (list (car pt) (cadr pt) 0.0)))) (if (vl-catch-all-error-p result) nil (= result acPointInside) ) ) nil ) ) ; 计算多边形的边界框 (defun GetPolygonBoundingBox (poly / minX maxX minY maxY) (setq minX 1e99 maxX -1e99 minY 1e99 maxY -1e99) (foreach pt poly (setq minX (min minX (car pt))) (setq maxX (max maxX (car pt))) (setq minY (min minY (cadr pt))) (setq maxY (max maxY (cadr pt))) ) (list (list minX minY) (list maxX maxY)) ) ; 点是否在边界框内 (defun PointInBoundingBox (pt bbox) (and (>= (car pt) (car (car bbox))) (<= (car pt) (car (cadr bbox))) (>= (cadr pt) (cadr (car bbox))) (<= (cadr pt) (cadr (cadr bbox))) ) ) ; 主程序 (vl-load-com) (setvar 'cmdecho 0) (princ "\n批量修改块属性高程 v12.2 - 稳定兼容版") (princ "\n=====================================") ; 选择操作模式 (initget 1 "Block Poly") (setq mode (getkword "\n选择操作模式 [块(Block)/多段线(Poly)] <Block>: ")) (if (not mode) (setq mode "Block")) ; 根据模式获取选择集 (cond ((= mode "Block") (princ "\n请选择要修改的块参照: ") (setq ss (ssget '((0 . "INSERT")))) (if (not ss) (progn (princ "\n未选择任何块参照。") (exit) ) ) ) ((= mode "Poly") (princ "\n请选择多段线(支持开/闭): ") (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE")))) (if (not ss) (progn (princ "\n未找到多段线。") (exit) ) ) ; 获取多段线顶点列表总边界框 (setq polyList nil) (setq regions nil) (setq minX 1e99 maxX -1e99 minY 1e99 maxY -1e99) (repeat (setq i (sslength ss)) (setq ent (ssname ss (setq i (1- i)))) (setq entData (entget ent)) (setq closedFlag (cdr (assoc 70 entData))) (setq polyObj (vlax-ename->vla-object ent)) ; 处理多段线 (cond ((= (cdr (assoc 0 entData)) "LWPOLYLINE") (setq coords (vlax-safearray->list (vlax-variant-value (vlax-get-property polyObj 'Coordinates)))) (setq ptList nil) (setq j 0) (repeat (/ (length coords) 2) (setq pt (list (nth j coords) (nth (1+ j) coords))) (setq minX (min minX (car pt))) (setq maxX (max maxX (car pt))) (setq minY (min minY (cadr pt))) (setq maxY (max maxY (cadr pt))) (setq ptList (cons pt ptList)) (setq j (+ j 2)) ) (setq ptList (reverse ptList)) ) ((= (cdr (assoc 0 entData)) "POLYLINE") (setq ptList nil) (setq nextEnt (entnext ent)) (while (and nextEnt (not (eq (cdr (assoc 0 (entget nextEnt))) "SEQEND"))) (setq vertexData (entget nextEnt)) (if (eq (cdr (assoc 0 vertexData)) "VERTEX") (progn (setq pt (cdr (assoc 10 vertexData))) (setq minX (min minX (car pt))) (setq maxX (max maxX (car pt))) (setq minY (min minY (cadr pt))) (setq maxY (max maxY (cadr pt))) (setq ptList (cons (list (car pt) (cadr pt)) ptList)) ) ) (setq nextEnt (entnext nextEnt)) ) (setq ptList (reverse ptList)) ) ) ; 如果多段线是闭合的,添加首尾点 (if (and (or (= closedFlag 1) (= closedFlag 129)) (> (length ptList) 2)) (setq ptList (append ptList (list (car ptList)))) ) ; 添加到多边形列表 (setq polyList (cons ptList polyList)) (princ (strcat "\n处理多段线: " (cdr (assoc 5 entData)) " 顶点数: " (itoa (length ptList)))) ; 尝试创建区域对象(仅适用于闭合多段线) (if (and (or (= closedFlag 1) (= closedFlag 129)) (> (length ptList) 2)) (progn (setq region (CreateRegionFromPoly polyObj)) (if region (setq regions (cons region regions)) (princ "\n警告: 无法为该多段线创建区域对象") ) ) ) ) ; 决定使用哪种检测方法 (setq useRayCasting (null regions)) (if use极Casting (princ "\n使用射线法进行点包含检测") (princ (strcat "\n使用区域对象检测 (创建了 " (itoa (length regions)) " 个区域)")) ) ; 计算总边界框(扩大5%容差) (setq expand (* 0.05 (max (- maxX minX) (- maxY minY)))) (if (< expand 0.1) (setq expand 0.1)) ; 最小容差 (setq minX (- minX expand)) (setq maxX (+ maxX expand)) (setq minY (- minY expand)) (setq maxY (+ maxY expand)) ; 使用窗口选择边界框内的块 (setq ss (ssget "_W" (list minX minY) (list maxX maxY) '((0 . "INSERT")))) (if (not ss) (progn (princ "\n边界框内没有块参照。") (exit) ) ) (princ (strcat "\n边界框内找到 " (itoa (sslength ss)) " 个块参照")) ; 创建临时选择集用于存储多边形内的块 (setq insideBlocks (ssadd)) ; 遍历边界框内的块参照 (repeat (setq i (sslength ss)) (setq ent (ssname ss (setq i (1- i)))) (setq blockObj (vlax-ename->vla-object ent)) (setq minPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint blockObj)))) (setq minPt (list (car minPt) (cadr minPt))) ; 只取XY坐标 ; 检查块是否在多边形内 (setq inside nil) (if useRayCasting ; 使用射线法 (foreach poly polyList (if (PointInsidePolygon minPt poly) (setq inside t) ) ) ; 使用区域对象检测 (foreach region regions (if (PointInRegion minPt region) (setq inside t) ) ) ) ; 如果在多边形内,则添加到选择集 (if inside (ssadd ent insideBlocks) ) ) (if (= (sslength insideBlocks) 0) (progn (princ "\n选中的多段线内没有块参照。") (exit) ) ) (setq ss insideBlocks) (princ (strcat "\n精确找到 " (itoa (sslength ss)) " 个多段线内的块参照")) ) ) ; 固定属性标签为 "hight" (setq attrTag "hight") (princ (strcat "\n将修改所有块的 \"" attrTag "\" 属性值并更新块Z坐标")) ; 获取高程变化值 (setq deltaValue (getreal "\n请输入高程变化值(正数加/负数减): ")) (if (not deltaValue) (progn (princ "\n输入无效。") (exit) ) ) ; 初始化计数器 (setq totalBlocks 0 modifiedBlocks 0 skippedBlocks 0 nonNumericBlocks 0) ; 获取当前文档的选择集 (setq acadApp (vlax-get-acad-object)) (setq activeDoc (vla-get-ActiveDocument acadApp)) (setq selSet (vla-get-ActiveSelectionSet activeDoc)) ; 遍历选择集 (setq blocks nil) (vlax-for block selSet (setq blocks (cons block blocks)) ) (vlax-release-object selSet) (setq totalBlocks (length blocks)) (foreach block blocks (setq blockName (vla-get-Name block)) ; 检查是否有属性 (if (vlax-property-available-p block 'HasAttributes) (if (eq (vla-get-HasAttributes block) :vlax-true) (progn (setq atts (vlax-invoke block 'GetAttributes)) (setq attrFound nil) ; 查找目标属性 (foreach att atts (if (= (strcase (vla-get-TagString att)) (strcase attrTag)) (progn (setq attrFound t) (setq oldValue (vla-get-TextString att)) (if (setq numValue (distof oldValue)) (progn ; 计算新的高程值 (setq newZ (+ numValue deltaValue)) (setq newValue (rtos newZ 2 3)) ; 更新属性值 (vla-put-TextString att newValue) ; 更新块的Z坐标 (setq insPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint block)))) (vla-put-InsertionPoint block (vlax-3d-point (car insPt) (cadr insPt) newZ)) ; 更新计数器 (setq modifiedBlocks (1+ modifiedBlocks)) ; 显示修改信息 (princ (strcat "\n修改块: " blockName " 属性: " attrTag " 原值: " oldValue " → 新值: " newValue " Z坐标更新为: " (rtos newZ 2 3))) ) (progn (setq nonNumericBlocks (1+ nonNumericBlocks)) (princ (strcat "\n跳过非数值属性: " blockName "." attrTag " = \"" oldValue "\"")) ) ) ) ) ) (if (not attrFound) (progn (setq skippedBlocks (1+ skippedBlocks)) (princ (strcat "\n跳过块: " blockName " (无" attrTag "属性)")) ) ) ) (progn (setq skippedBlocks (1+ skippedBlocks)) (princ (strcat "\n跳过无属性块: " blockName)) ) ) (progn (setq skippedBlocks (1+ skippedBlocks)) (princ (strcat "\n跳过无属性块: " blockName)) ) ) ) ; 清理区域对象 (if regions (foreach r regions (if (not (vlax-erased-p r)) (vla-delete r) ) ) ) ; 显示统计信息 (princ (strcat "\n\n==== 操作完成 ====" "\n总块参照数: " (itoa totalBlocks) "\n成功修改块: " (itoa modifiedBlocks) "\n跳过无属性块: " (itoa skippedBlocks) "\n非数值属性块: " (itoa nonNumericBlocks))) (setvar 'cmdecho 1) (princ) ) ; 加载提示 (princ "\n批量修改块高程命令: MODIFYBLOCKELEVATIONALL") (princ) 检查代码中的括号问题
最新发布
07-19
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值