代码合并2个多段线带属性

(DEFUN C:FWHP (/         A-LWPOLYLINE3DUAN   ABH       AE
               AEPTS         AI           AI0             AN               APT
               B-LWPOLYLINE3DUAN   BBH             BE               BEPTS
               BI         GO           N             OSMODE    PT1
               PT2         PTS           SS             STARTLIST TMP
               X
              )
  (SETVAR "cmdecho" 0)
  (command ".undo")
  (command "end")
  (command ".undo")
  (command "begin")
  (setq OSMODE (GETVAR "osmode"))
  (SETVAR "osmode" (LOGIOR (GETVAR "osmode") 16384))
  (if (AND (setq PT1 (GETPOINT "\n点击第一个面（要保留属性的面）："))
           (setq PT2 (GETPOINT PT1 "\n点击第二个面（放弃属性的面）："))
           (setq SS (SSGET "f"
                           (LIST PT1 PT2)
                           '((0 . "LWPOLYLINE")
                             (8 . "~权属线")
                             (8 . "~JZD")
                             (-4 . "&=")
                             (70 . 1)
                            )
                    )
           )
           (= (setq N (SSLENGTH SS)) 2)
      )
    (PROGN
      (PRINC "\n已选上")
      (setq AE (SSNAME SS 0))
      (setq BE (SSNAME SS 1))
      (setq A-LWPOLYLINE3DUAN (LWPOLYLINE3DUANXIAN (ENTGET AE '("*"))))
      (setq B-LWPOLYLINE3DUAN (LWPOLYLINE3DUANXIAN (ENTGET BE '("*"))))
      (setq AEPTS (CADR A-LWPOLYLINE3DUAN))
      (setq BEPTS (CADR B-LWPOLYLINE3DUAN))
      (setq PT1 (LIST (CAR PT1) (CADR PT1)))
      (setq PT2 (LIST (CAR PT2) (CADR PT2)))
      (if
        (OR
          (AND (PTINOROUT1 AEPTS PT1) (PTINOROUT1 BEPTS PT2))
          (AND (PTINOROUT1 AEPTS PT2)
               (PTINOROUT1 BEPTS PT1)
               (MAPCAR
                 'SET
                 '(AE BE AEPTS BEPTS A-LWPOLYLINE3DUAN B-LWPOLYLINE3DUAN)
                 (LIST BE               AE               BEPTS
                       AEPTS               B-LWPOLYLINE3DUAN
                       A-LWPOLYLINE3DUAN
                      )
               )
          )
        )
         (PROGN
           (setq AI -1)
           (setq AN (LENGTH AEPTS))
           (setq GO T)
           (while (and (AND GO (< (setq AI (1+ AI)) AN)))
             (setq APT (NTH AI AEPTS))
             (if (setq BI (VL-POSITION APT BEPTS))
               (PROGN (setq GO nil))
             )
           )
           (if BI
             (PROGN
               (setq AI0 AI)
               (setq STARTLIST (CAR A-LWPOLYLINE3DUAN))
               (setq ABH (CDR (ASSOC 70 STARTLIST)))
               (if (OR (= ABH 1) (= ABH 129))
                 (PROGN (setq ABH T))
                 (PROGN (setq ABH nil))
               )
               (if ABH
                 (PROGN (setq TMP (BF-LIST-SPLIT-INDEX AEPTS AI)))
               )
               (setq AEPTS (APPEND (CADR TMP) (CAR TMP)))
               (setq BBH (CDR (ASSOC 70 (CAR B-LWPOLYLINE3DUAN))))
               (if (OR (= BBH 1) (= BBH 129))
                 (PROGN (setq BBH T))
                 (PROGN (setq BBH nil))
               )
               (if BBH
                 (PROGN (setq TMP (BF-LIST-SPLIT-INDEX BEPTS BI)))
               )
               (setq BEPTS (APPEND (CADR TMP) (CAR TMP)))
               (COND
                 ((EQUAL (CADR AEPTS) (CADR BEPTS) 0.001)
                  (setq        PTS (APPEND (CDDR AEPTS)
                                    (LIST (CAR BEPTS))
                                    (REVERSE (CDR BEPTS))
                            )
                  )
                 )
                 ((EQUAL (CADR AEPTS) (LAST BEPTS) 0.001)
                  (setq PTS (APPEND (CDDR AEPTS) BEPTS))
                 )
                 ((EQUAL (LAST AEPTS) (CADR BEPTS) 0.001)
                  (setq PTS (APPEND AEPTS (CDDR BEPTS)))
                 )
                 ((EQUAL (LAST AEPTS) (LAST BEPTS) 0.001)
                  (setq PTS (APPEND AEPTS (CDR (REVERSE (CDR BEPTS)))))
                 )
               )
               (if PTS
                 (PROGN
                   (if (ENTMOD
                         (APPEND (SUBST        (CONS 90 (LENGTH PTS))
                                        (ASSOC 90 STARTLIST)
                                        STARTLIST
                                 )
                                 (MAPCAR '(LAMBDA (X) (CONS 10 X)) PTS)
                         )
                       )
                     (PROGN (ENTDEL BE))
                   )
                 )
               )
             )
           )
         )
         (PROGN (PRINC "\n选择点不在多边形内"))
      )
    )
    (PROGN (PRINC "\n选上的房屋不是两个"))
  )
  (SETVAR "osmode" OSMODE)
  (command ".undo")
  (command "end")
  (PRINC)
)
(DEFUN BF-LIST-SPLIT-INDEX (LST INDEX / RESULT TMP)
  (setq TMP LST)
  (REPEAT INDEX
    (setq RESULT (CONS (CAR TMP) RESULT))
    (setq TMP (CDR TMP))
  )
  (LIST (REVERSE RESULT) (BF-LIST-LTRIM LST INDEX))
)
(DEFUN BF-LIST-LTRIM (LST M)
  (COND        ((OR (ZEROP M) (MINUSP M) (>= M (LENGTH LST))) LST)
        (T (REPEAT M (setq LST (CDR LST))))
  )
)
(DEFUN PTINOROUT1 (PTS PT / P1 P2)
  (setq
    PTS        (MAPCAR
          '(LAMBDA (P1 P2) (REM (- (ANGLE PT P1) (ANGLE PT P2)) PI))
          (CONS (LAST PTS) PTS)
          PTS
        )
  )
  (EQUAL (ABS (APPLY '+ PTS)) PI 1.0e-012)
)
(DEFUN MJ:MASSOC (KEY ALIST)
  (APPLY 'APPEND
         (MAPCAR '(LAMBDA (X)
                    (IF        (EQ (CAR X) KEY)
                      (LIST (CDR X))
                    )
                  )
                 ALIST
         )
  )
)
(DEFUN LWPOLYLINE3DUANXIAN (EL / I LINE AB START TMP)
  (setq START nil)
  (setq TMP nil)
  (setq LINE nil)
  (setq I 0)
  (while (and (setq AB (NTH I EL)))
    (if        (= 10 (CAR AB))
      (PROGN (if LINE
               (PROGN (setq LINE (APPEND LINE (LIST (CDR AB))))
                      (setq I (+ 3 I))
               )
               (PROGN (setq START TMP)
                      (setq TMP nil)
                      (setq LINE (APPEND (LIST (CDR AB)) LINE))
                      (setq I (+ 3 I))
               )
             )
      )
      (PROGN (setq TMP (APPEND TMP (LIST AB))))
    )
    (setq I (+ 1 I))
  )
  (LIST START LINE TMP)
)
(DEFUN XYP-ENTMAKE-LWPOLYLINE (PTLST COLOR / C)
  (ENTMAKE (APPEND (LIST '(0 . "LWPOLYLINE")
                         '(100 . "AcDbEntity")
                         '(100 . "AcDbPolyline")
                         (CONS 62 COLOR)
                         (CONS 90 (LENGTH PTLST))
                   )
                   (MAPCAR '(LAMBDA (C) (CONS 10 C)) PTLST)
           )
  )
  (PRINC)
)

每天都能学到新知识，赞！

谢谢分享

回复，顶帖，赚币，谢谢楼主

感谢楼主

感谢楼主

谢谢分享

谢谢分享

好啊好啊~这不错~感想分享~

感谢楼主