吾爱汇编论坛

 找回密码
 立即注册

QQ登录

绑定QQ避免忘记帐号

查看: 389|回复: 44

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

  [复制链接]

  离线 

升级   13.33%

zhangmaobo721 发表于 2021-11-23 11:03 | 显示全部楼层 |阅读模式


(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)
)


评分

参与人数 8HB +5 THX +4 收起 理由
agan8888 + 1
zxjzzh + 1 [吾爱汇编论坛52HB.COM]-学破解防破解,知进攻懂防守!
pmm018 + 1
king51999 + 1 [快捷评语]--吃水不忘打井人,给个评分懂感恩!
jhf123 + 1 [快捷评语]--你将受到所有人的崇拜!
蓝色青菜 + 1 [快捷评语]--积极评分,从我做起。感谢分享!
endbeach + 1 + 1
liugu0hai + 1 积极评分,从我做起

查看全部评分

吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   5%

结实踢吐司 发表于 2022-1-22 20:19 | 显示全部楼层
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   26.67%

钢笔781490 发表于 2022-1-28 13:50 | 显示全部楼层


谢谢分享
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   75%

bTckhDOlMA 发表于 2022-1-29 14:08 | 显示全部楼层
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   38%

EQJjHBgCr 发表于 2022-1-29 23:11 | 显示全部楼层


感谢楼主
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   42.03%

tiEo943 发表于 2022-1-29 23:11 | 显示全部楼层
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   90%

月饼3527 发表于 2022-2-4 00:02 | 显示全部楼层


谢谢分享
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   36.23%

Idiptygh194 发表于 2022-2-18 23:55 | 显示全部楼层


谢谢分享
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   34%

tmuNDTbVP 发表于 2022-2-19 01:02 | 显示全部楼层


好啊好啊~这不错~感想分享~
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM

  离线 

升级   44.2%

YVQOH0948 发表于 2022-2-19 02:13 | 显示全部楼层


感谢楼主
吾爱汇编论坛-学破解,防破解!知进攻,懂防守!逆向分析,软件安全!52HB.COM
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则 警告:本站严惩灌水回复,尊重自己从尊重他人开始!

1层
2层
3层
4层
5层
6层
7层
8层
9层
10层

免责声明

吾爱汇编论坛(www.52hb.com)所发布的破解补丁、注册机、逆向教程、逆向文章等,包含但不限于上述内容,仅限用于学习和研究目的,不得用于非法途径或商业行为。否则,一切后果请用户自行承担。本站内容源于网络,版权争议与本站无关。您必须在下载后的24个小时之内,从您的电脑中彻底删除。如果您喜欢某程序,请购买正版,支持正版,获得正版优质服务。如有侵权请邮件或微信与我们联系处理。

站长邮箱:SharkHeng@iCloud.com
站长微信:SharkHeng


QQ|RSS|手机版|小黑屋|帮助|吾爱汇编论坛 ( 京公网安备11011502005403号 , 京ICP备20003498号 )

GMT+8, 2022-5-21 06:55 , Processed in 0.235751 second(s), 77 queries .

Powered by Discuz!

吾爱汇编论坛 www.52hb.com

快速回复 返回顶部 返回列表