CAD悬挂点检查（源码）_悬挂点检查_小懒人CAD工具箱_小懒人插件

dlvincent

we are studying

qumeiyuan11

懒人CAD工具箱_小懒人

dy001

wssulan 发表于 2019-3-11 09:06
能不能在悬挂点上标一个圈呢？

;;;
;;;功能:悬挂点检查
;;;逆流而上的鱼制作
;;;QQ736188807
(defun c:tt();;;;悬挂点检查
  (vl-load-com)
  (if (and
        (setq ss (ssget (list (cons 0 "*POLYLINE"))))
;;;        (setq pt (getpoint "\n 指定错误信息定向点<退出>"))
        )
    (progn
      (setvar "OSMODE" 0)
      (setvar "cecolor" "1")
      (command "ZOOM" "E")
      (repeat (setq k (sslength ss))
        (setq ent (ssname ss (setq k (1- k))))
        (setq obj (vlax-ename->vla-object ent))
        (setq pt1 (vlax-curve-getEndPoint obj))
        (setq pt2 (vlax-curve-getStartPoint obj))
        (if (setq ss1 (ssget "C" pt1 pt1 (list (cons 0 "*POLYLINE"))))
          (if (= (sslength ss1) 1)
;;;            (command "LINE" pt pt1 "")
            (command "CIRCLE" pt1 0.5)
            )
          )
        (if (setq ss1 (ssget "C" pt2 pt2 (list (cons 0 "*POLYLINE"))))
          (if (= (sslength ss1) 1)
;;;            (command "LINE" pt pt2 "")
            (command "CIRCLE" pt2 0.5)
            )
          )
        )
      (command "ZOOM" "P")
      )
    )
  )

wigis

看看如何&#128522;

15031933695

谢谢楼主分享

yimengshan

11111111111111

coverme

地板的建议不错

wssulan

dy001 发表于 2019-3-11 22:01
;;;
;;;功能:悬挂点检查
;;;逆流而上的鱼制作

非常感谢

wssulan

wssulan 发表于 2019-3-12 09:08
非常感谢

能再问一个问题吗，这是生成元数据mdb的代码，需要在cass中创建一个结合表，有几个图层填写对应内容，但是忘了怎么做了，您能指导一下吗
(DEFUN C:YSJ-500()
  (SETQ F(OPEN"D:\\元数据.TXT" "W"))
  (SETQ TH(SSGET(LIST(CONS 8 "500TH")(CONS 0 "TEXT"))))
  (SETQ GS(SSLENGTH TH)K 0)
  (WHILE(< K GS)
    (SETQ TH1(CDR(ASSOC 1(ENTGET(SSNAME TH K)))))
    (SETQ X(*(ATOF(SUBSTR TH1 9 6))1000))
    (SETQ Y(*(ATOF(SUBSTR TH1 1 8))1000))
    (SETQ TKCD 250)
    (IF(SETQ TM(SSGET"W"(LIST X Y)(MAPCAR '+ (LIST X Y)(LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
      (SETQ TM(CDR(ASSOC 1(ENTGET(SSNAME TM 0)))))
      (SETQ TM "无")
    )
    (SETQ BLC "500")
    (SETQ XNX(RTOS X 2 0)
   XNY(RTOS Y 2 0)
   DBX(RTOS (+ X TKCD) 2 0)
   DBY(RTOS (+ Y TKCD) 2 0)
     )

   
    (setq DGJ(CDR(ASSOC 1(ENTGET(SSNAME(SSGET"W"(LIST X Y)(MAPCAR '+ (LIST X Y)(LIST TKCD TKCD))(LIST(CONS 8 "等高距")(CONS 0 "TEXT")))0)))))
    (SETQ XB(SSGET"W"(LIST X Y)(MAPCAR '+ (LIST X Y)(LIST (* -1 TKCD) TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
    (IF XB(SETQ XB"已接")(SETQ XB "自由边"))
    (SETQ BB(SSGET"W"(MAPCAR '+(LIST X Y)(LIST 0 TKCD))(MAPCAR '+ (LIST X Y)(LIST (* 1 TKCD) (* 2 TKCD)))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
    (IF BB(SETQ BB"已接")(SETQ BB "自由边"))
    (SETQ DB(SSGET"W"(MAPCAR '+(LIST X Y)(LIST TKCD 0))(MAPCAR '+ (LIST X Y)(LIST (* 2 TKCD) (* 1 TKCD)))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
    (IF DB(SETQ DB"已接")(SETQ DB "自由边"))
    (SETQ NB(SSGET"W"(MAPCAR '+(LIST X Y)(LIST 0 (* -1 TKCD)))(MAPCAR '+ (LIST X Y)(LIST (* 1 TKCD) (* 0 TKCD)))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
    (IF NB(SETQ NB"已接")(SETQ NB "自由边"))
    (SETQ ZB(MAPCAR '+(LIST X Y)(LIST(* TKCD -1)(* TKCD 1))));结合图西北(command "pline" ZB (MAPCAR '+ ZB (LIST TKCD TKCD)) "")
    (SETQ JHTXB(SSGET"W" ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
    (IF JHTXB
      (SETQ JHTXB(CDR(ASSOC 1(ENTGET(SSNAME JHTXB 0)))))
      (PROGN
(SETQ JHTXB(SSGET"W"ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
        (IF JHTXB(SETQ JHTXB(CDR(ASSOC 1(ENTGET(SSNAME JHTXB 0)))))
(SETQ JHTXB "无")
        )
)
      )
    (SETQ ZB(MAPCAR '+(LIST X Y)(LIST(* TKCD 0)(* TKCD 1))));结合图北(command "pline" ZB (MAPCAR '+ ZB (LIST TKCD TKCD)) "")
    (SETQ JHTB(SSGET"W" ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
    (IF JHTB
      (SETQ JHTB(CDR(ASSOC 1(ENTGET(SSNAME JHTB 0)))))
      (PROGN
(SETQ JHTB(SSGET"W"ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
        (IF JHTB(SETQ JHTB(CDR(ASSOC 1(ENTGET(SSNAME JHTB 0)))))
(SETQ JHTB "无")
        )
)
      )
    (SETQ ZB(MAPCAR '+(LIST X Y)(LIST(* TKCD 1)(* TKCD 1))));结合图东北
    (SETQ JHTDB(SSGET"W" ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
    (IF JHTDB
      (SETQ JHTDB(CDR(ASSOC 1(ENTGET(SSNAME JHTDB 0)))))
      (PROGN
(SETQ JHTDB(SSGET"W"ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
        (IF JHTDB(SETQ JHTDB(CDR(ASSOC 1(ENTGET(SSNAME JHTDB 0)))))
(SETQ JHTDB "无")
        )
)
      )
    (SETQ ZB(MAPCAR '+(LIST X Y)(LIST(* TKCD -1)(* TKCD 0))));结合图西
    (SETQ JHTX(SSGET"W" ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
    (IF JHTX
      (SETQ JHTX(CDR(ASSOC 1(ENTGET(SSNAME JHTX 0)))))
      (PROGN
(SETQ JHTX(SSGET"W"ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
        (IF JHTX(SETQ JHTX(CDR(ASSOC 1(ENTGET(SSNAME JHTX 0)))))
(SETQ JHTX "无")
        )
)
      )
    (SETQ ZB(MAPCAR '+(LIST X Y)(LIST(* TKCD 1)(* TKCD 0))));结合图东
    (SETQ JHTD(SSGET"W" ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
    (IF JHTD
      (SETQ JHTD(CDR(ASSOC 1(ENTGET(SSNAME JHTD 0)))))
      (PROGN
(SETQ JHTD(SSGET"W"ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
        (IF JHTD(SETQ JHTD(CDR(ASSOC 1(ENTGET(SSNAME JHTD 0)))))
(SETQ JHTD "无")
        )
)
      )
    (SETQ ZB(MAPCAR '+(LIST X Y)(LIST(* TKCD -1)(* TKCD -1))));结合图西南
    (SETQ JHTXN(SSGET"W" ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
    (IF JHTXN
      (SETQ JHTXN(CDR(ASSOC 1(ENTGET(SSNAME JHTXN 0)))))
      (PROGN
(SETQ JHTXN(SSGET"W"ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
        (IF JHTXN(SETQ JHTXN(CDR(ASSOC 1(ENTGET(SSNAME JHTXN 0)))))
(SETQ JHTXN "无")
        )
)
      )
    (SETQ ZB(MAPCAR '+(LIST X Y)(LIST(* TKCD 0)(* TKCD -1))));结合图南
    (SETQ JHTN(SSGET"W" ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
    (IF JHTN
      (SETQ JHTN(CDR(ASSOC 1(ENTGET(SSNAME JHTN 0)))))
      (PROGN
(SETQ JHTN(SSGET"W"ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
        (IF JHTN(SETQ JHTN(CDR(ASSOC 1(ENTGET(SSNAME JHTN 0)))))
(SETQ JHTN "无")
        )
)
      )
    (SETQ ZB(MAPCAR '+(LIST X Y)(LIST(* TKCD 1)(* TKCD -1))));结合图东南
    (SETQ JHTDN(SSGET"W" ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500图幅名称*")(CONS 0 "TEXT"))))
    (IF JHTDN
      (SETQ JHTDN(CDR(ASSOC 1(ENTGET(SSNAME JHTDN 0)))))
      (PROGN
(SETQ JHTDN(SSGET"W"ZB (MAPCAR '+ ZB (LIST TKCD TKCD))(LIST(CONS 8 "500TH*")(CONS 0 "TEXT"))))
        (IF JHTDN(SETQ JHTDN(CDR(ASSOC 1(ENTGET(SSNAME JHTDN 0)))))
(SETQ JHTDN "无")
        )
)
      )
    (SETQ ZYY(CDR(ASSOC 1(ENTGET(SSNAME(SSGET"W" (LIST X Y) (MAPCAR '+ (LIST X Y) (LIST TKCD TKCD))(LIST(CONS 8 "作业员")(CONS 0 "TEXT")))0)))))
    (SETQ JCY(CDR(ASSOC 1(ENTGET(SSNAME(SSGET"W" (LIST X Y) (MAPCAR '+ (LIST X Y) (LIST TKCD TKCD))(LIST(CONS 8 "检查员")(CONS 0 "TEXT")))0)))))
    (SETQ DHY(CDR(ASSOC 1(ENTGET(SSNAME(SSGET"W" (LIST X Y) (MAPCAR '+ (LIST X Y) (LIST TKCD TKCD))(LIST(CONS 8 "调绘员")(CONS 0 "TEXT")))0)))))
    (SETQ CTY(CDR(ASSOC 1(ENTGET(SSNAME(SSGET"W" (LIST X Y) (MAPCAR '+ (LIST X Y) (LIST TKCD TKCD))(LIST(CONS 8 "测图员")(CONS 0 "TEXT")))0)))))

    (WRITE-LINE(STRCAT "地理空间框架建设" "," TH1 "," TM "," BLC "," "国土资源局" "," "三院" ","
       "2016/01" "," XNX "," XNY "," DBX "," DBY "," "秘密" "," "AutoCAD 2004 DWG" "," "2000国家大地坐标系" ","
       "1985国家高程基准" "," "米" "," DGJ "," "航片" "," "UCOp" "," "0.07" "," "50.20" ","
       "2015/12" "," "2016/01" "," CTY "," "2016/02" "," DHY "," "无" "," XB "," BB "," DB "," NB "," JHTXB "," JHTB ","
       JHTDB "," JHTX "," JHTD "," JHTXN "," JHTN "," JHTDN "," ZYY "," JCY)F)
    (PRINT(STRCAT(RTOS GS 2 0)"//"(RTOS K 2 0)))
   (PRINT)
    (SETQ K(+ K 1))
    )
  
  (CLOSE F)
  )

lqss

33333333333333333333333333333333