admin1 发表于 2024-5-7 20:08:28

图块统计

(defun strLength (str / sLength x1 x2 lst)
        (setq lst (textbox (list (cons 1 str))))
        (setq x1 (car (nth 0 lst))
                x2 (car (nth 1 lst))
        )
        (setq sLength (abs (- x2 x1)))
        sLength
)
;;; -------------------------------------------------------------------------
;;;以当前设置初始化文本高、宽
(defun initText (/ pt str eTextN)
        (setq pt (list 0 0))
        (setq str "初始化")
        (command "text" pt #ZiGao# 0 str)
        (setq eTextN (entlast))
        (entdel eTextN)
)
;;; -------------------------------------------------------------------------
;;; 返回polyline的点表
;;;调用参数形式 (多义线图元名 )
(defun getplpts (pl / mark pts ver1 i ee pt)
        (if (= "POLYLINE" (cdr (assoc 0 (entget pl))))
                (progn; read points of ployline
                        (setq mark "VERTEX"
                                i    0
                                ver1 (entnext pl)
                        )
                        (while (= "VERTEX" mark)
                                (setq pts (append pts (list (cdr (assoc 10 (entget ver1))))))
                                (setq ver1 (entnext ver1)
          i    (1+ i)
                                )
                                (setq mark (cdr (assoc 0 (entget ver1))))
                        )
                )
                (progn; read points of lwployline
                        (setq ee (entget pl))
                        (foreach pt ee
                                (if (= 10 (car pt))
                                        (setq
                                                pts (append
                                                                        pts
                                                                        (list (append (cdr pt) (list (cdr (assoc 38 ee)))))
                                                                )
                                        )
                                )
                        )
                )
        )
        pts
)
(defun AddLineone (listStartPoint listEndPoint)
        (setq clay (getvar "clayer"))    ; 原始图层状态赋值给oldlay
        (if (null (tblsearch "LAYER" "4B-CH NOTES")) ; 如果还没有001图层
    (command "._layer" "m" "4B-CH NOTES" "c" "240" "" "lt" "continuous" "" "LW"
                        "0.13" "" ""
    )
    (setvar "clayer" "4B-CH NOTES")         ; 否则直接转换到001图层
)
        (entmake (list '(0 . "LINE")
                                               (cons 10 listStartPoint)
                                               (cons 11 listEndPoint)
                                       )
        )
        (while (/= 0 (getvar "cmdactive"))   ; 没有它回不到原来图层
    (command pause)
)
(SETVAR "CLAYER" CLAY)
)
(defun AddText_AlignmentMiddle(listInsertPoint floatTextHigh floatRotateAngle strText floatScaleFactorstrStyleName)
        (setq clay (getvar "clayer"))    ; 原始图层状态赋值给oldlay
        (if (null (tblsearch "LAYER" "4B-CH NOTES")) ; 如果还没有003图层
    (command "._layer" "m" "4B-CH NOTES" "c" "100" "" "lt" "continuous" "" "LW"
                        "0.13" "" ""
    )
    (setvar "clayer" "4B-CH NOTES")         ; 否则直接转换到003图层
)
        (entmake (list '(0 . "TEXT")
                                               '(10 0 0 0)
                                               (cons 11 listInsertPoint)
                                               (cons 40 floatTextHigh)
                                               (cons 1 strText)
                                               (cons 50 floatRotateAngle)
                                               (cons 41 floatScaleFactor)
                                               (cons 7 strStyleName)
                                               '(72 . 1)
                                               '(100 . "AcDbText")
                                       )
        )
        (while (/= 0 (getvar "cmdactive"))   ; 没有它回不到原来图层
    (command pause)
)
(SETVAR "CLAYER" CLAY)
)
;;;------------------------------------------------------------------------
(defun AddText_AlignmentMiddleone(listInsertPointone floatTextHighone floatRotateAngleone strTextone floatScaleFactoronestrStyleNameone)
        (setq clay (getvar "clayer"))    ; 原始图层状态赋值给oldlay
        (if (null (tblsearch "LAYER" "0")) ; 如果还没有0图层
    (command "._layer" "m" "0" "c" "255" "" "lt" "continuous" "" "LW"
                        "0.13" "" ""
    )
    (setvar "clayer" "0")         ; 否则直接转换到0图层
)
        (entmake (list '(0 . "TEXT")
                                               '(10 0 0 0)
                                               (cons 11 listInsertPointone)
                                               (cons 40 floatTextHighone)
                                               (cons 1 strTextone)
                                               (cons 50 floatRotateAngleone)
                                               (cons 41 floatScaleFactorone)
                                               (cons 7 strStyleNameone)
                                               '(72 . 1)
                                               '(100 . "AcDbText")
                                       )
        )
        (while (/= 0 (getvar "cmdactive"))   ; 没有它回不到原来图层
    (command pause)
)
(SETVAR "CLAYER" CLAY)
)
;;;------------------------------------------------------------------------
(defun AddText_AlignmentMiddletwo(listInsertPointtwo floatTextHightwo floatRotateAngletwo strTexttwo floatScaleFactortwostrStyleNametwo)
        (setq clay (getvar "clayer"))    ; 原始图层状态赋值给oldlay
        (if (null (tblsearch "LAYER" "4B-CH NOTES")) ; 如果还没有004图层
    (command "._layer" "m" "4B-CH NOTES" "c" "210" "" "lt" "continuous" "" "LW"
                        "0.13" "" ""
    )
    (setvar "clayer" "4B-CH NOTES")         ; 否则直接转换到004图层
)
        (entmake (list '(0 . "TEXT")
                                               '(10 0 0 0)
                                               (cons 11 listInsertPointtwo)
                                               (cons 40 floatTextHightwo)
                                               (cons 1 strTexttwo)
                                               (cons 50 floatRotateAngletwo)
                                               (cons 41 floatScaleFactortwo)
                                               (cons 7 strStyleNametwo)
                                               '(72 . 1)
                                               '(100 . "AcDbText")
                                       )
        )
        (while (/= 0 (getvar "cmdactive"))   ; 没有它回不到原来图层
    (command pause)
)
(SETVAR "CLAYER" CLAY)
)
;;;------------------------------------------------------------------------
(defun AddText_AlignmentMiddlethree(listInsertPointthree floatTextHighthree floatRotateAnglethree strTextthree floatScaleFactorthreestrStyleNamethree)
        (setq clay (getvar "clayer"))    ; 原始图层状态赋值给oldlay
        (if (null (tblsearch "LAYER" "4B-CH NOTES")) ; 如果还没有005图层
    (command "._layer" "m" "4B-CH NOTES" "c" "41" "" "lt" "continuous" "" "LW"
                        "0.13" "" ""
    )
    (setvar "clayer" "4B-CH NOTES")         ; 否则直接转换到005图层
)
        (entmake (list '(0 . "TEXT")
                                               '(10 0 0 0)
                                               (cons 11 listInsertPointthree)
                                               (cons 40 floatTextHighthree)
                                               (cons 1 strTextthree)
                                               (cons 50 floatRotateAnglethree)
                                               (cons 41 floatScaleFactorthree)
                                               (cons 7 strStyleNamethree)
                                               '(72 . 1)
                                               '(100 . "AcDbText")
                                       )
        )
        (while (/= 0 (getvar "cmdactive"))   ; 没有它回不到原来图层
    (command pause)
)
(SETVAR "CLAYER" CLAY)
)
;;输出表头
;;;------------------------------------------------------------------------
;;;在当前图层、当前空间、按文本左对齐方式,写单行文本
;;;调用形式 (AddText_AlignmentLeft插入点坐标 显示 文本旋转角度(rad)文本内容宽高比例 字体样式名),如果成功,返回定义数据的图元表,否则返回 nil。
(defun AddText_AlignmentLeft(listInsertPoint floatTextHigh floatRotateAngle strText floatScaleFactorstrStyleName)
        (entmake (list '(0 . "TEXT")
                                               (cons 10 listInsertPoint)
                                               (cons 40 floatTextHigh)
                                               (cons 1 strText)
                                               (cons 50 floatRotateAngle)
                                               (cons 41 floatScaleFactor)
                                               (cons 7 strStyleName)
                                               '(100 . "AcDbText")
                                       )
        )
)
;;;------------------------------------------------------------------------
;;;在当前图层、当前空间插入块
;;;调用形式 ( InsertBlock显示插入点旋转角度 )
;;;成功时,返回dxf组码,否则返回nil
(defun InsertBlock ( strBlockName listInsertPoint floatRotateAngle )
        (entmake (list '(0 . "INSERT")
                                               '(100 . "AcDbEntity")
                                               '(100 . "AcDbBlockReference")
                                               (cons 2 strBlockName)
                                               (cons 10 listInsertPoint)
                                               (cons 50 floatRotateAngle)))
)
;;;-------------------------------------------------------------
;;;标记undo编组开始点
(defun BeginUndoGroup()
        (command "undo" "be")
)
;;; -------------------------------------------------------------------------
;;;标记undo编组结束点
(defun EndUndoGroup()
        (command "undo" "e")
)
;;; -------------------------------------------------------------------------
;;; -------------------------------------------------------------------------
;;; -------------------------------------------------------------------------
;;; -------------------------------------------------------------------------
;;; -------------------------------------------------------------------------
;;块统计.LSP
;;;--------------------------------------------------------------------------------
;;;从块选择集中选择指定块名的对象,并返回结果选择集
(defun intCountSingleBlock (ssOriginal strTargetBlockName /
                                                                                                               strEntityName listEntityDXF strBlockName intSingleBlockCount k)
        (setq intSingleBlockCount 0
                k -1 )
        (repeat (sslength ssOriginal) ; 循环与所选择的对象数量相等的次数
                (setq strEntityName (ssname ssOriginal (setq k (1+ k)))) ; strEntityName,取得第k个对象名
                (setq listEntityDXF (entget strEntityName))
                (setq strBlockName (cdr (assoc 2 listEntityDXF)))
                (if (= strBlockName strTargetBlockName)
                        (setq intSingleBlockCount (1+ intSingleBlockCount))
                )
        )
        intSingleBlockCount
)
;;;--------------------------------------------------------------------------------
;;;从块选择集中删除指定块名的对象,并返回结果选择集
(defun ssDelEntitysFromBlockSelectionSet (ssOriginal strTargetBlockName
                                                                                                                                                                       / strEntityName listEntityDXF strBlockName ssResult k)
        (setq ssResult (ssadd)
                k -1 )
        (repeat (sslength ssOriginal) ; 循环与所选择的对象数量相等的次数
                (setq strEntityName (ssname ssOriginal (setq k (1+ k)))) ; strEntityName,取得第k个对象名
                (setq listEntityDXF (entget strEntityName))
                (setq strBlockName (cdr (assoc 2 listEntityDXF)))
                (if (/= strBlockName strTargetBlockName)
                        (setq ssResult (ssadd strEntityName ssResult))
                )
        )
        ssResult
)
;;;--------------------------------------------------------------------------------
;;;插入块缩略图
(defun PrintBlockMiniature (floatBasicPointX                  floatBasicPointY                  strBlockName
                                                                                                               /                                 floatMaxBlockWidth                floatMaxBlockHigh
                                                                                                               floatBlockOriginalWidth         floatBlockOriginalHigh            floatBlockWidthScale
                                                                                                               floatBlockHighScale               floatBlockBoundingBoxTargetMinPointX
                                                                                                               floatBlockBoundingBoxTargetMinPointY   floatBlockBoundingBoxTargetMaxPointX
                                                                                                               floatBlockBoundingBoxTargetMaxPointY   listTargetBlockCenterPoint
                                                                                                               listBlockBoundingBoxMinPoint      listBlockBoundingBoxMaxPoint      objectBlockEntity
                                                                                                               strEntityName                     listInsertPoint                   floatBlockScale
                                                                                                               listBlockEntityDXF                listBlockCenterPoint
                           )
        ;; floatBasicPointX floatBasicPointY 缩略图所在表格单元左下角点坐标
        ;;计算图块缩略图在图中允许放置范围的左下及右上角点坐标的X、Y数值
        (setq floatMaxBlockWidth 21
                floatMaxBlockHigh 8
        )
        (setq floatBlockBoundingBoxTargetMinPointX (+ floatBasicPointX 2)
                floatBlockBoundingBoxTargetMinPointY (+ floatBasicPointY 1)
                floatBlockBoundingBoxTargetMaxPointX (+ floatBasicPointX floatMaxBlockWidth 2)
                floatBlockBoundingBoxTargetMaxPointY (+ floatBasicPointY floatMaxBlockHigh 1)
        )
        (setq listTargetBlockCenterPoint (list (/ (+ floatBlockBoundingBoxTargetMinPointXfloatBlockBoundingBoxTargetMaxPointX ) 2)
                                                                                                                                               (/ (+ floatBlockBoundingBoxTargetMinPointY floatBlockBoundingBoxTargetMaxPointY )2 )
                                                                                                                                               0
                                                                                                                                       )
        )
        (setq listInsertPoint (list floatBlockBoundingBoxTargetMinPointXfloatBlockBoundingBoxTargetMinPointY) )
        (InsertBlock strBlockName listInsertPoint 0)
        ;;以块缩略图允许放置范围的左下角点为块缩略图的基点插入图块
        (setq strEntityName (entlast))
        (setq objectBlockEntity (vlax-ename->vla-object strEntityName))
        (if(vl-catch-all-error-p (vl-catch-all-apply 'vla-GetBoundingBox
                                                                                                                       (list objectBlockEntity'listBlockBoundingBoxMinPoint 'listBlockBoundingBoxMaxPoint ))
                       ) ;判断块是否存在边框,若块含无限长直线等时,则不存在边框
    (AddText_AlignmentMiddle listBlockCenterPoint 3 0 "本块无缩略图" 0.8 "standard")
    (progn
                        (setq listBlockBoundingBoxMinPoint (vlax-safearray->list listBlockBoundingBoxMinPoint) )
                        (setq listBlockBoundingBoxMaxPoint (vlax-safearray->list listBlockBoundingBoxMaxPoint) )
                        (if (> (car listBlockBoundingBoxMaxPoint)(car listBlockBoundingBoxMinPoint) )
                                (setq floatBlockWidthScale (/ floatMaxBlockWidth
                                     (- (car listBlockBoundingBoxMaxPoint) (car listBlockBoundingBoxMinPoint) )
                                                                                                                                       )
                                )
                                (setqfloatBlockWidthScale 0)
                        )
                        (if (> (cadr listBlockBoundingBoxMaxPoint) (cadr listBlockBoundingBoxMinPoint))
                                (setq   floatBlockHighScale(/ floatMaxBlockHigh
                                                                                                                                                       (- (cadr listBlockBoundingBoxMaxPoint) (cadr listBlockBoundingBoxMinPoint) )
                                                                                                                                               )
                                )
                                (setq   floatBlockHighScale 0)
                        )
                        ;计算块缩略图允许放置范围的边框长宽与块外框长宽的比值
                        (cond
                                ((= (+ floatBlockWidthScale floatBlockHighScale) 0)(setq floatBlockScale 1)) ;块为单点时,缩放比例取为1
                                ((=floatBlockWidthScale 0)(setq floatBlockScale floatBlockHighScale) ) ;块为竖直短线时
                                ((=floatBlockHighScale 0)(setq floatBlockScale floatBlockWidthScale) ) ;块为水平短线时
                                ((> floatBlockWidthScale floatBlockHighScale )(setq floatBlockScale floatBlockHighScale) ) ;数值较小者为块的控制缩放比例
                                (T(setq floatBlockScale floatBlockWidthScale) )
                        )
                        (setq listBlockEntityDXF (entget strEntityName))
                        (entmod (subst (cons 41 floatBlockScale) (assoc 41 listBlockEntityDXF) listBlockEntityDXF ) )
                        (entupd strEntityName)
                        (setq listBlockEntityDXF (entget strEntityName))
                        (entmod (subst (cons 42 floatBlockScale) (assoc 42 listBlockEntityDXF) listBlockEntityDXF ) )
                        (entupd strEntityName)
                        (setq listBlockEntityDXF (entget strEntityName))
                        (entmod (subst (cons 43 floatBlockScale) (assoc 43 listBlockEntityDXF) listBlockEntityDXF ) )
                        (entupd strEntityName)
                        ;;缩放块
                        (vla-GetBoundingBox objectBlockEntity 'listBlockBoundingBoxMinPoint 'listBlockBoundingBoxMaxPoint)
                        (setq listBlockBoundingBoxMinPoint (vlax-safearray->list listBlockBoundingBoxMinPoint) )
                        (setq listBlockBoundingBoxMaxPoint (vlax-safearray->list listBlockBoundingBoxMaxPoint) )
                        (setq listBlockCenterPoint (list (* 0.5 (+ (car listBlockBoundingBoxMaxPoint) (car listBlockBoundingBoxMinPoint) ) )
                                                                                                                                       (* 0.5 (+ (cadr listBlockBoundingBoxMaxPoint) (cadr listBlockBoundingBoxMinPoint) ) )
                                                                                                                                       0
                                                                                                                               )
                        )
                        (vla-move objectBlockEntity (vlax-3d-point listBlockCenterPoint) (vlax-3d-point listTargetBlockCenterPoint))
                )
        )
)
;;;--------------------------------------------------------------------------------
;;;--------------------------------------------------------------------------------
;;;显示统计结果表
(defun PrintCountResultList (listResult/iListLength strBlockName
                                                                                                                        intNumberOfSSSingleBlockName   strNumberOfSSSingleBlockNamept pt1 pt2pt3 pt4 pt5 pt6 pt7xyx1y1 y2
                                                                                                                        x2x3floatTextHigh floatTextHighoneblocknumber blocknumbersum)
        (setq pt0 (getpoint "\n点取要标注块统计结果信息的位置:"));;;;;;;;;;
        (setq pt (polar pt0 0 25))        ;;;;;
        (setq x (car pt)
                y (cadr pt)
                x0 (car pt0)
                y0 (cadr pt0)
                i 1
                floatTextHigh 4
                floatTextHighone 7
                floatTextHightwo 4.5
        )
        (setq ListLength (length listResult))
        (setq y1 (- y0 (* (1+ (+ 1 ListLength)) 10))) ;行高取10
        (while (<= i 5)
                (setq x1 (+ x0 (* i 25))) ;列宽取25
                (setq pt1 (list x1 y0 0)
                        pt2 (list x1 y1 0)
                )
                (AddLineone pt1 pt2)
                (setq i (1+ i))
        )
        ;;;画竖向表格线
        (setq i 1)
        (setq x1 (+ x (* 5 25)))
        (while (<= i (1+ ListLength))
                (setq y1 (- y0 (* i 10)))
                (setq pt1 (list x0 y1 0)
                        pt2 (list x1 y1 0)
                )
                (AddLineone pt1 pt2)
                (setq i (1+ i))
        )
        ;;;画横向表格线
        ;;;------------------------------------------------------------------------
        (setq clay (getvar "clayer"))    ; 原始图层状态赋值给oldlay
        (if (null (tblsearch "LAYER" "002")) ; 如果还没有002图层
    (command "._layer" "m" "002" "c" "41" "" "lt" "continuous" "" "LW"
                        "0.5" "" ""
    )
    (setvar "clayer" "002")         ; 否则直接转换到002图层
)
        (setq x1 (+ x (* 5 25))
                y1 (- y (* 10 (+ 2 ListLength))))
(setq pt1 (list x y 0)
                pt2 (list x1 y1 0)
                pt3 (list x0 y1 0)
                pt4 (list x1 y 0)
)
        (command "pline" pt0 pt4 pt2 pt3 "c")
(princ)
        (while (/= 0 (getvar "cmdactive"))   ; 没有它回不到原来图层
    (command pause)
)
(SETVAR "CLAYER" CLAY)
        ;;;画外围矩形
        ;;;------------------------------------------------------------------------
        (setq x1 (+ x (* 0.5 25))
                x2 (+ x (* 1.5 25))
                x3 (+ x (* 2.5 25))
                x4 (+ x (* 3.5 25))
                x5 (+ x (* 4.5 25))
                y1 (- y 7)
                y2 (+ y 5)
        )
        (setq pt1 (list x1 y1 0)
                pt2 (list x2 y1 0)
                pt3 (list x3 y1 0)
                pt4 (list x4 y1 0)
                pt5 (list x5 y1 0)
                pt8 (list x3 y2 0)
                pt9 (list (+ x (* 0.5 -25)) y1 0);;;;;;;;;
        )
        (AddText_AlignmentMiddlethree pt1 floatTextHigh 0 "缩略图" 0.5 "standard")
        (AddText_AlignmentMiddlethree pt2 floatTextHigh 0 "名称" 0.5 "standard")
        (AddText_AlignmentMiddlethree pt3 floatTextHigh 0 "数量" 0.5 "standard")
        (AddText_AlignmentMiddlethree pt4 floatTextHigh 0 "条码" 0.5 "standard")
        (AddText_AlignmentMiddlethree pt5 floatTextHigh 0 "备注" 0.5 "standard")
        (AddText_AlignmentMiddlethree(polar pt8 (* 1 pi) 12.5) floatTextHighone 0 "数量统计" 0.5 "standard")
        (AddText_AlignmentMiddlethree pt9 floatTextHigh 0 "序号" 0.5 "standard")
        ;;输出表头
        ;;;------------------------------------------------------------------------
        点评
        (setq i 0
                floatTextHigh 3
                blocknumber 0    )
        (while (< i ListLength)
                (setq y1 (+ y (* -10 (+ i 2))))
                (setq ;pt1 (list x1 y1 0)
                        pt2 (list x2 (+ y1 3) 0)
                        pt3 (list x3 (+ y1 3) 0)
                        pt9 (polar pt2 (* 1 pi) 50) ;;;;;
                )
                (setq strBlockName (car (nth i listResult))
                        intNumberOfSSSingleBlockName (cadr (nth i listResult))
                )
                (setq blocknumber (+ blocknumber intNumberOfSSSingleBlockName))
                (setq strNumberOfSSSingleBlockName (itoa intNumberOfSSSingleBlockName))
                (AddText_AlignmentMiddle pt2 floatTextHigh 0 strBlockName 0.8 "standard")
                (AddText_AlignmentMiddle pt3 floatTextHigh 0 strNumberOfSSSingleBlockName 1.0 "standard")
                (AddText_AlignmentMiddle pt9 floatTextHigh 0 (itoa (1+ i)) 1.0 "standard");;;;;;;;;;;;;;;;;;;;;;
                (if (vl-catch-all-error-p (vl-catch-all-apply 'PrintBlockMiniature (list x y1 strBlockName)))
                        (AddText_AlignmentLeft (list (+ x 1) (+ y1 2)) 3 0 "生成灯缩略图时出错" 0.5 "standard")
                )
                (setq i (1+ i))
        )
        ;;;显示表内容
        (setq i 0
                blocknumbersum 0 )
        (while (< i ListLength)
                (setq blocknumbersum (+ blocknumbersum intNumberOfSSSingleBlockName))
                (setq i (1+ i))
        )
        (setq intNumberOfSSSingleBlockName (itoa blocknumbersum))
        (setq strNumberOfSSSingleBlockName (itoa blocknumber))
        (setq   y1 (- (- y (* 10 (+ 1 ListLength))) 7 )
        )
        (setq pt5 (list x1 y1 0)
                pt6 (list x2 y1 0)
                pt7 (list x3 y1 0)
        )
        (AddText_AlignmentMiddletwo pt5 floatTextHightwo 0 intNumberOfSSSingleBlockName0.5 "standard")
        (AddText_AlignmentMiddle pt5 floatTextHightwo 0 "共      种"0.5 "standard")
        (AddText_AlignmentMiddlethree pt6 floatTextHightwo 0 "汇总" 0.5 "standard")
        (AddText_AlignmentMiddletwo pt7 floatTextHightwo 0 strNumberOfSSSingleBlockName 0.5 "standard")
        (AddText_AlignmentMiddle pt7 floatTextHightwo 0 "共       个"0.5 "standard")
        ;;输出表尾
        ;;;------------------------------------------------------------------------
)
;;;--------------------------------------------------------------------------------
(defun GetBlocksSelectionRange (/ strDCLFileName listInputDefinements listKeysAndValues listKeysAndActions listKeysToGetValue
                                                                                                                               listDCLReturn intButtonClick strSelectRange)
        (setq strSelectRange"UserSelection" )
        (setq strDCLFileName "BlocksSelectionRange")
        (setq listInputDefinements '(("dialog" "指定统计范围" "")
                                                                                                                                ("spacer")
                              ("radio_column" "进行块统计的范围:")
                                                                                                                                ("btRadio" "手工选择" "brUserSelection")
                                                                                                                                ("btRadio" "整个图形" "brDrawingFile")
                              ("end")
                              ("text" "注:不统计含无限长直线的块!")
                                                                                                                                ("spacer")
                                                                                                                                ("btOK")
                                                                                                                                ("end")
                                                                                                                        )
        )
        (setq listKeysAndValues '(("brUserSelection" "1")))
        (setq listKeysAndActions '(("brUserSelection" "(setq strSelectRange \"UserSelection\")")
                                                                                                                        ("brDrawingFile" "(setq strSelectRange \"DrawingFile\")")) )
        (setq listKeysToGetValue nil)
        (setq listDCLReturn (listGenerateDCL strDCLFileName listInputDefinements listKeysAndValues listKeysAndActions listKeysToGetValue) )
        (setq intButtonClick (car listDCLReturn ))
        strSelectRange
)
;;;--------------------------------------------------------------------------------
;;;块数量统计
(defun tktj (/ ssObjectsstrEntityNamelistEntityDXFstrBlockName
                                                        listResultintSingleBlockCountlistMinPoint listInsertPointfloatBlockRotateAngle
                                                        ;;listResult 用于记录统计结果,形式为((显示块数量同名块中一个实体的对象名 )...)
                                                )
        ; (initget "D S _DrawingFile UserSelection")
        ; (setq strSelectRange (getkword "\n统计块的范围[显示(D)/显示(S)]<S>:"))
        (setq strSelectRange "手动选择");;;;;;;;;;;;;;;;
        (if (= strSelectRange "DrawingFile")
                (setq ssObjects(ssget "X" '((0 . "insert")(100 . "AcDbBlockReference")))) ; 创建选择集 ssObjects
                (progn
                        (princ "\n请选择需要统计的块:\n")
                        (setq ssObjects (ssget '((0 . "INSERT")(100 . "AcDbBlockReference")))) ; 创建选择集 ssObjects
                )
        )
        (if ssObjects
                (progn
                        (setq listResult nil)
                        (while (> (sslength ssObjects) 0)
                                (setq strEntityName (ssname ssObjects 0)) ; strEntityName,取得第1个对象名
                                (setq listEntityDXF (entget strEntityName))
                                (setq strBlockName (cdr (assoc 2 listEntityDXF)))
                                (setq intSingleBlockCount (intCountSingleBlock ssObjects strBlockName ) )
                                (setq ssObjects (ssDelEntitysFromBlockSelectionSet ssObjects strBlockName))
                                (setq listResult (append listResult
                                                                                                       (list (list strBlockName intSingleBlockCount))
                                                                                               )
                                )
                        )
                        (setvar "dimzin" 8)
                        (setvar "osmode" 0)
                        (if(tblsearch "style" "standard")
                                ;;判断是否存在"standard"字体,有则设为当前,无则创建。
                                (setvar "textstyle" "standard")
                                (command "_style" "standard" "sceie.shx,sceic.shx" 0 0.5 0 "N" "N" "N")
                        )
                        (PrintCountResultList listResult)
                        (setvar "osmode" 16383)
                )
        )
        (princ)
)
(defun c:kp()(tktj));QY :596099781
;;;--------------------------------------------------------------------------------
页: [1]
查看完整版本: 图块统计