计算坐标

爱莫能助

(defun ayGetAllEntInBLK
       (BlkEntName / xBlkName xBlkDef entName1 entType entNameList)
  (setq xBlkName (cdr (assoc 2 (entget BlkEntName))))
  (setq xBlkDef (tblobjname "Block" xBlkName))
  (setq xlist '() ylist '())
  (while (setq entName1 (entnext xBlkDef))
    (setq entType (cdr (assoc 0 (entget entName1))))
    (if  (= entType "INSERT")
      (setq entNameList
       (append (ayGetAllEntInBLK entName1) entNameList)
      )
      (and (or (= entType "LINE") (= entType "LWPOLYLINE") (= entType "CIRCLE") (= entType "ARC"))  
      (progn
(setq o (vlax-ename->vla-object entName1))
(vlax-method-applicable-p o 'getboundingbox)
(vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))
(setq p1 (vlax-safearray->list a))
(setq p9 (vlax-safearray->list b))
(setq p1x (Car p1))
(setq p9x (Car p9))
(setq p1y (Cadr p1))
(setq p9y (Cadr p9))
(setq xlist (cons p1x xlist))
(setq xlist (cons p9x xlist))
(setq ylist (cons p1y ylist))
(setq ylist (cons p9y ylist))
      )
    )
      
    )         
    (setq xBlkDef entName1)
  )
  (list (List (apply 'min xlist) (apply 'min ylist)) (List (apply 'max xlist) (apply 'max ylist)))
)

;这是论坛大佬的代码，我在上面改了一下想计算块内坐标，结果出来结果不对，应该是要转换一下计算才，我不会，望大神出手

hhhaaa1121

如果是计算左下角和右上角坐标程序应该没问题吧.
会不会是没有调用 (VL-LOAD-COM)?

爱莫能助

hhhaaa1121 发表于 2022-7-17 12:21
如果是计算左下角和右上角坐标程序应该没问题吧.
会不会是没有调用 (VL-LOAD-COM)?

不是计算不了，是计算的结果，不是图形上，，以0点计算了

hhhaaa1121

明白了,加个嵌套吧.
(defun ayGetAllEntInBLK2 (BlkEntName / a b entname1 entnamelist enttype o p1 p1x p1y p9 p9x p9y xblkdef xblkname xlist ylist)
  (setq xBlkName (cdr (assoc 2 (entget BlkEntName))))
  (setq xBlkDef (tblobjname "Block" xBlkName))
  (setq xlist '()
        ylist '()
  )
  (while (setq entName1 (entnext xBlkDef))
    (setq entType (cdr (assoc 0 (entget entName1))))
    (if (= entType "INSERT")
      (setq entNameList (append
                          (ayGetAllEntInBLK entName1)
                          entNameList
                        )
      )
      (and
        (or
          (= entType "LINE")
          (= entType "LWPOLYLINE")
          (= entType "CIRCLE")
          (= entType "ARC")
        )
        (progn
          (setq o (vlax-ename->vla-object entName1))
          (vlax-method-applicable-p o 'getboundingbox)
          (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))
          (setq p1 (vlax-safearray->list a))
          (setq p9 (vlax-safearray->list b))
          (setq p1x (Car p1))
          (setq p9x (Car p9))
          (setq p1y (Cadr p1))
          (setq p9y (Cadr p9))
          (setq xlist (cons p1x xlist))
          (setq xlist (cons p9x xlist))
          (setq ylist (cons p1y ylist))
          (setq ylist (cons p9y ylist))
        )
      )

    )
    (setq xBlkDef entName1)
  )
  (list (List (apply
                'min
                xlist
              ) (apply
                  'min
                  ylist
                )
        ) (List (apply
                  'max
                  xlist
                ) (apply
                    'max
                    ylist
                  )
          )
  )
)

(DEFUN ayGetAllEntInBLK (BLKENTNAME / LB P0 P1)
  (SETVAR "CMDECHO" 0)
  (SETQ P0 '(0 0))
  (COMMAND "COPY" BLKENTNAME "" P0 P0)
  (PRINT)
  (COMMAND "EXPLODE" "L")
  (PRINT)
  (COMMAND "COPYBASE" P0 "P" "")
  (PRINT)
  (COMMAND "ERASE" "P" "")
  (COMMAND "_pasteblock" '(0 0))
  (SETQ LB (SSNAME (SSGET "l") 0))
  (SETQ P1 (ayGetAllEntInBLK2 LB))
  (COMMAND "erase" "l" "")
  (SETVAR "CMDECHO" 1)
  P1
)

爱莫能助

hhhaaa1121 发表于 2022-7-17 17:26
明白了,加个嵌套吧.
(defun ayGetAllEntInBLK2 (BlkEntName / a b entname1 entnamelist enttype o p1 p1x ...

(setq aa (ayGetAllEntInBLK (car (entsel))))

提示错误，函数被取消
另外，能不用COPY  与 炸散吗，直接坐标转换计算

hhhaaa1121

出错可能是捕捉模式的问题，这个程序是对块原始数据计算对角，如果块只是平移缩放还行，块旋转的话坐标转换解决不了，原程序要动手术。
加个关闭捕捉再试下吧，行不行都是它了。
(DEFUN ayGetAllEntInBLK (BLKENTNAME / LB P0 P1 OS)
  (SETVAR "CMDECHO" 0)
  (SETQ OS (GETVAR "osmode"))
  (SETVAR "OSMODE" 0)
  (SETQ P0 '(0 0))
  (COMMAND "COPY" BLKENTNAME "" P0 P0)
  (COMMAND "EXPLODE" "L")
  (COMMAND "COPYBASE" P0 "P" "")
  (COMMAND "ERASE" "P" "")
  (COMMAND "_pasteblock" p0)
  (SETQ LB (SSNAME (SSGET "l") 0))
  (SETQ P1 (ayGetAllEntInBLK2 LB))
  (COMMAND "erase" "l" "")
  (SETVAR "OSMODE" OS)
  (SETVAR "CMDECHO" 1)
  P1
)