矩形分图

cjf160204

http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTI0Mjk1fDcyZDMxZjhjMTdiYTEyZDRkZWRkNjUxY2RlM2M3ZGMwfDE3MzI0NzM0MTU%3D&request=yes&_f=.vlx

lxl217114

打开论坛，被楼主霸屏，看看发了什么好东西。

cjf160204

       矩形分图

zmzk

怎么用啊？介绍下啊

cjf160204

zmzk 发表于 2023-1-12 12:01
怎么用啊？介绍下啊

命令就是jxft

shuiyeqing

大大，可以上个源码吗？为什么每次框选后只出来两个一样的图？

cjf160204

shuiyeqing 发表于 2024-9-27 11:54
大大，可以上个源码吗？为什么每次框选后只出来两个一样的图？

(DEFUN CORNP( FENT / PMIN PMAX MINP MAXP )
    (vla-GetBoundingBox (vlax-ename->vla-object FENT) 'MINP 'MAXP)
    (setq PMAX (vlax-safearray->list MAXP))
    (setq PMIN (vlax-safearray->list MINP))
    (LIST (LIST (CAR PMIN) (CADR PMIN))
          (LIST (CAR PMAX) (CADR PMAX))
    )
)

(DEFUN 4PT( FENT / PMIN PMAX MINP MAXP )
    (vla-GetBoundingBox (vlax-ename->vla-object FENT) 'MINP 'MAXP)
    (setq PMAX (vlax-safearray->list MAXP))
    (setq PMIN (vlax-safearray->list MINP))
    (LIST (LIST (CAR PMIN) (CADR PMIN))
          (LIST (CAR PMAX) (CADR PMIN))
          (LIST (CAR PMAX) (CADR PMAX))
          (LIST (CAR PMIN) (CADR PMAX))
          (LIST (CAR PMIN) (CADR PMIN))
    )
)

(DEFUN POINT( PBASE SX SY )
    (LIST (+ (CAR PBASE) SX) (+ (CADR PBASE) SY))
)

(DEFUN CUTRECTANGLE( ENT / ENTPLST )
    (setq ENTPLST (4PT ENT))
    (command "trim")
    (command ENT)
    (command "")
    (command "F")
    (command (POINT (CAR ENTPLST) -0.01 -0.01))
    (command (POINT (CADR ENTPLST) 0.01 -0.01))
    (command (POINT (CADDR ENTPLST) 0.01 0.01))
    (command (POINT (CADDDR ENTPLST) -0.01 0.01))
    (command (POINT (CAR ENTPLST) -0.01 -0.01))
    (command "")
    (command "")
    (LIST (CAR (CADR ENTPLST)) (CADR (CAR ENTPLST)))
)

(DEFUN C:C4( / ENT OSM )
    (while (and (setq ENT (CAR (ENTSEL))) )
        (setq OSM (GETVAR "osmode"))
        (SETVAR "osmode" 0)
        (command "zoom")
        (command "O")
        (command ENT)
        (command "")
        (command "zoom" )
        (command "0.7x")
        (CUTRECTANGLE ENT)
        (REPEAT 2 (command "zoom") (command "P"))
    )
    (PRINC)
)

(DEFUN C:JXFT( / SS I SSLST ENT X Y X1 X2 Y1 Y2 BASP JX OSM EPLST SSET 4P SSET1 DELSS P1LST ENTPAR W CW NSS )
    (if (NOT (setq SS (SSGET (LIST (CONS 0 "LWPOLYLINE") (CONS 90 4) (CONS 70 1)))))
        (PROGN
            (VL-EXIT-WITH-VALUE 0)
        )
    )
    (setq I -1)
    (setq W 0)
    (while (and (setq ENT (SSNAME SS (setq I (1+ I)))) )
        (setq P1LST (VL-REMOVE-IF '(lambda (E) (/= 10 (CAR E))) (ENTGET ENT)))
        (if (> (setq CW (FIX (DISTANCE (CDR (CAR P1LST)) (CDR (CADDR P1LST))))) W)
            (PROGN
                (setq W CW)
            )
        )
    )
    (setq I -1)
    (setq NSS (SSADD))
    (while (and (setq ENT (SSNAME SS (setq I (1+ I)))) )
        (setq P1LST (VL-REMOVE-IF '(lambda (E) (/= 10 (CAR E))) (ENTGET ENT)))
        (if (= (setq CW (FIX (DISTANCE (CDR (CAR P1LST)) (CDR (CADDR P1LST))))) W)
            (PROGN
                (SSADD ENT NSS)
            )
        )
    )
    (setq SS NSS)
    (setq I -1)
    (setq SSLST nil)
    (setq X1 nil)
    (setq X2 nil)
    (setq Y1 nil)
    (setq Y2 nil)
    (while (and (setq ENT (SSNAME SS (setq I (1+ I)))) )
        (setq ENTPAR (ENTGET ENT))
        (setq X (CADR (ASSOC 10 ENTPAR)))
        (setq Y (CADDR (ASSOC 10 ENTPAR)))
        (if (= I 0)
            (PROGN
                (setq P1LST (VL-REMOVE-IF '(lambda (E) (/= 10 (CAR E))) ENTPAR))
                (setq JX (* 0.5 (ABS (- (CADR (CAR P1LST)) (CADR (CADDR P1LST))))))
                (setq X1 X)
                (setq X2 X)
                (setq Y1 Y)
                (setq Y2 Y)
            )
            (PROGN
                (setq X1 (MIN X1 X))
                (setq X2 (MAX X2 X))
                (setq Y1 (MIN Y1 Y))
                (setq Y2 (MAX Y2 Y))
            )
        )
        (setq SSLST (CONS (LIST ENT X) SSLST))
    )
    (if (< (- Y2 Y1) (- X2 X1))
        (PROGN
            (setq SSLST (VL-SORT SSLST '(lambda (E1 E2) (< (CADR E1) (CADR E2)))))
        )
        (PROGN
            (setq SSLST (VL-SORT SSLST '(lambda (E1 E2) (> (CADDR E1) (CADDR E2)))))
        )
    )
    (setq BASP (TRANS (GETPOINT "\n  &#892;    :") 1 0))
    (command "undo")
    (command "be")
    (command "ucs")
    (command "")
    (setq OSM (GETVAR "osmode"))
    (SETVAR "osmode" 0)
    (setq OLTSCL (GETVAR "ltscale"))
    (setq I -1)
    (while (and (setq ENT (NTH (setq I (1+ I)) SSLST)) )
        (command "undo")
        (command "M")
        (setq ENT (CAR ENT))
        (command "zoom")
        (command "o")
        (command ENT)
        (command "")
        (setq EPLST (CORNP ENT))
        (setq 4P (4PT ENT))
        (REPEAT 4
            (if (setq SSET1 (SSGET "f" 4P (LIST (CONS 0 "INSERT"))))
                (PROGN
                    (setq J -1)
                    (while (and (setq JENT (SSNAME SSET1 (setq J (1+ J)))) )
                        (command "explode")
                        (command JENT)
                        (if (= 1 (GETVAR "cmdactive"))
                            (PROGN
                                (command "")
                            )
                        )
                    )
                )
            )
        )
        (setq SSET (SSGET "w" (CAR EPLST) (CADR EPLST)))
        (setq SSET1 (SSGET "f" 4P))
        (command "copy")
        (command SSET)
        (command SSET1)
        (command "r")
        (command SS)
        (command "")
        (command (CAR EPLST))
        (command BASP)
        (command "copy")
        (command ENT)
        (command "")
        (command (CAR EPLST))
        (command BASP)
        (command "zoom")
        (command "O")
        (command (ENTLAST))
        (command "")
        (command "zoom")
        (command "0.75x")
        (setq EPLST (CORNP (ENTLAST)))
        (setq SSET (SSGET "c" (CAR EPLST) (CADR EPLST)))
        (command "copybase")
        (command (CAR EPLST))
        (command SSET)
        (command "")
        (command "undo")
        (command "B")
        (command "pasteclip")
        (command (CAR EPLST))
        (setq ENT1 (ENTLAST))
        (command "zoom")
        (command "O")
        (command ENT1)
        (command "")
        (command "zoom")
        (command "0.75x")
        (SETVAR "ltscale" 10000)
        (CUTRECTANGLE ENT1)
        (SETVAR "ltscale" 0.0001)
        (setq BASP (POINT (CUTRECTANGLE ENT1) JX 0))
        (setq 4P (4PT ENT1))
        (setq SSET (SSGET "w" (CAR 4P) (CADDR 4P)))
        (if (setq DELSS (SSGET "c" (POINT (CAR 4P) (* -0.5 JX) -1.01) (POINT (CADR 4P) (* 0.5 JX) (* -0.5 JX)) (LIST (CONS 0 "*LINE"))))
            (PROGN
                (command "erase")
                (command DELSS)
                (command "r")
                (command SSET)
                (command "")
            )
        )
        (if (setq DELSS (SSGET "c" (POINT (CADR 4P) 1.01 (* -0.5 JX)) (POINT (CADDR 4P) (* 0.5 JX) (* 0.5 JX)) (LIST (CONS 0 "*LINE"))))
            (PROGN
                (command "erase")
                (command DELSS)
                (command "r")
                (command SSET)
                (command "")
            )
        )
        (if (setq DELSS (SSGET "c" (POINT (CADDR 4P) (* 0.5 JX) 1.01) (POINT (CADDDR 4P) (* -0.5 JX) (* 0.5 JX)) (LIST (CONS 0 "*LINE"))))
            (PROGN
                (command "erase")
                (command DELSS)
                (command "r")
                (command SSET)
                (command "")
            )
        )
        (if (setq DELSS (SSGET "c" (POINT (CAR 4P) -1.01 (* -0.5 JX)) (POINT (CADDDR 4P) (* -0.5 JX) (* 0.5 JX)) (LIST (CONS 0 "*LINE"))))
            (PROGN
                (command "erase")
                (command DELSS)
                (command "r")
                (command SSET)
                (command "")
            )
        )
        (REPEAT 2 (command "zoom") (command "P"))
    )
    (SETVAR "osmode" OSM)
    (SETVAR "ltscale" OLTSCL)
    (command "undo")
    (command "e")
    (PRINC)
)