第一次发帖，求助万能的晓东家园

q3_2006 · 发表于 2013-8-15 17:59:16

G版的程序能达到目的，但楼主要的是跟BO命令一样，用“拾取点”的方式形成边界，这个才是重点！

q3_2006 · 发表于 2013-8-15 18:06:07

牢固发表于 2013-8-15 17:28

楼主要的是跟BO命令一样，用“拾取点”的方式形成边界，贴图里，只是在线内点击了一下，就形成边界了，这个是怎么做到的？？

牢固 · 发表于 2013-8-15 18:50:15

q3_2006 发表于 2013-8-15 18:06
楼主要的是跟BO命令一样，用“拾取点”的方式形成边界，贴图里，只是在线内点击了一下，就形成边界了，这 ...

;;(c:MyJoin)模糊串线,By Gu_xl 2013.08.15
;;点选方式
(defun c:MyJoin (/ *error* CMDECHO PEDITACCEPT SS
SSL PL LST LL UR CIR
CP PTS1 PTS2 pt
)
(defun *error* (s)
(setvar 'peditaccept peditaccept)
(setvar 'cmdecho cmdecho)
(princ s)
)
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq peditaccept (getvar 'peditaccept))
(setvar 'peditaccept 1)
;(setq ss (ssget '((0 . "line,arc,*polyline"))))
(setq pt (getpoint "\n选取点:"))
(setq ss (gxl-sel-ssgetByptray (trans pt 1 0) '((0 . "line,arc,*polyline"))))
(if ss
(progn
(setq ssl (GXL-SEL-SS->LIST ss))
(setq
pl (apply 'append
(setq lst (mapcar '(lambda (a)
(list (vlax-curve-getStartPoint a)
(vlax-curve-getendPoint a)
)
)
ssl
)
)
)
)
(setq ll (apply 'mapcar (cons 'min pl))
ur (apply 'mapcar (cons 'max pl))
)
(command "_circle"
"2p"
"_non"
(trans ll 0 1)
"_non"
(trans ur 0 1)
)
(setq cir (entlast))
(setq cp (cdr (assoc 10 (entget cir))))
(setq lst
(mapcar
'(lambda (x)
(if (apply 'gxl-Clockwise-p (cons cp x))
(reverse x)
x
)
)
lst
)
lst
(vl-sort
lst
'(lambda (a b)
(< (vlax-curve-getParamAtPoint
cir
(vlax-curve-getclosestpointto cir (car a))
)
(vlax-curve-getParamAtPoint
cir
(vlax-curve-getclosestpointto cir (car b))
)
)
)
)
)
(setq pts1 (car lst)
lst (append (cdr lst) (list pts1))
)
(while lst
(setq pts2 (car lst)
lst (cdr lst)
)
(if (not (equal (cadr pts1) (car pts2) 1e-3))
(progn
(command "_line"
"_non"
(trans (cadr pts1) 0 1)
"_non"
(trans (car pts2) 0 1)
""
)
(ssadd (entlast) ss)
)
)
(setq pts1 pts2)
)
(command "pedit" "m" ss "" "j" 1e-3 "")
(setvar 'peditaccept peditaccept)
(setvar 'cmdecho cmdecho)
(entdel cir)
)
)
(princ)
)
;;;选择集转为图元列表
(defun gxl-Sel-SS->List (ss / i s)
(if ss
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s))
)
)
)
;;(gxl-Clockwise-p p1 p2 p3)判断三点是否顺时针
(defun gxl-Clockwise-p ( p1 p2 p3 )
(<
(* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
)
)
;;pt = wcs
;;(setq ss (GXL-SEL-SSGETBYPTRAY (getpoint) '((0 . "line,arc,*polyline"))))
(defun gxl-sel-ssgetByptray (PT FILTER / VIEWSIZE LEN
P0 P2 P1 P3 ANG DA
SS PT1 PT2 S
)
(command "_ucs" "_w")
(setq viewsize (gxl-Sys-GetViewSize)
len (apply 'distance viewsize)
p0 (car viewsize) ;_ 左下
p2 (cadr viewsize) ;_ 右上
p1 (list (car p0) (cadr p2) ) ;_ 左上
p3 (list (car p2) (cadr p0) ) ;_ 右下
ang 0
da (/ pi 15)
ss (ssadd)
)
(repeat 30
(setq pt1 (polar pt ang len))
(vl-some '(lambda (a) (setq pt2 (inters pt pt1 (car a) (cadr a))))
(list (list p0 p1) (list p1 p2) (list p2 p3) (list p3 p0))
)
(setq s (ssget "F" (list pt pt2) filter))
(if s
(ssadd (cadar (ssnamex s)) ss)
)
(setq ang (+ ang da))
)
(command "_ucs" "_p")
(if (> (sslength ss) 0) ss)
)
(defun gxl-Sys-GetViewSize (/ pc vh sc vw vh pmin pmax)
(setq pc (getvar "viewctr")
vh (getvar "viewsize")
sc (getvar "screensize")
vw (* vh (/ (car sc) (cadr sc)))
pmin (list (- (car pc) (* 0.5 vw)) (- (cadr pc) (* 0.5 vh)))
pmax (list (+ (car pc) (* 0.5 vw)) (+ (cadr pc) (* 0.5 vh)))
)
(list pmin pmax)
)

;;(c:MyJoin)模糊串线,By Gu_xl 2013.08.15 
;;点选方式 
(defun c:MyJoin  (/   *error* CMDECHO PEDITACCEPT   SS 
     SSL   PL   LST   LL   UR   CIR 
     CP   PTS1   PTS2 pt 
    ) 
  (defun *error* (s) 
    (setvar 'peditaccept peditaccept) 
    (setvar 'cmdecho cmdecho) 
    (princ s) 
  ) 
  (setq cmdecho (getvar 'cmdecho)) 
  (setvar 'cmdecho 0) 
  (setq peditaccept (getvar 'peditaccept)) 
  (setvar 'peditaccept 1) 
  ;(setq ss (ssget '((0 . "line,arc,*polyline")))) 
  (setq pt (getpoint "\n选取点:")) 
  (setq ss (gxl-sel-ssgetByptray (trans pt 1 0) '((0 . "line,arc,*polyline")))) 
  (if ss 
    (progn 
      (setq ssl (GXL-SEL-SS->LIST ss)) 
      (setq 
  pl (apply 'append 
      (setq  lst (mapcar '(lambda (a) 
               (list (vlax-curve-getStartPoint a) 
               (vlax-curve-getendPoint a) 
               ) 
             ) 
            ssl 
          ) 
      ) 
     ) 
      ) 
      (setq ll (apply 'mapcar (cons 'min pl)) 
      ur (apply 'mapcar (cons 'max pl)) 
      ) 
      (command "_circle" 
         "2p" 
         "_non" 
         (trans ll 0 1) 
         "_non" 
         (trans ur 0 1) 
      ) 
      (setq cir (entlast)) 
      (setq cp (cdr (assoc 10 (entget cir)))) 
      (setq lst 
    (mapcar 
      '(lambda (x) 
         (if (apply 'gxl-Clockwise-p (cons cp x)) 
           (reverse x) 
           x 
         ) 
       ) 
      lst 
    ) 
      lst 
    (vl-sort 
      lst 
      '(lambda (a b) 
         (<  (vlax-curve-getParamAtPoint 
        cir 
        (vlax-curve-getclosestpointto cir (car a)) 
      ) 
      (vlax-curve-getParamAtPoint 
        cir 
        (vlax-curve-getclosestpointto cir (car b)) 
      ) 
         ) 
       ) 
    ) 
      ) 
      (setq pts1 (car lst) 
      lst   (append (cdr lst) (list pts1)) 
      ) 
      (while lst 
  (setq pts2 (car lst) 
        lst  (cdr lst) 
  ) 
  (if (not (equal (cadr pts1) (car pts2) 1e-3)) 
    (progn 
      (command "_line" 
         "_non" 
         (trans (cadr pts1) 0 1) 
         "_non" 
         (trans (car pts2) 0 1) 
         "" 
      ) 
      (ssadd (entlast) ss) 
    ) 
  ) 
  (setq pts1 pts2) 
      ) 
 
      (command "pedit" "m" ss "" "j" 1e-3 "") 
      (setvar 'peditaccept peditaccept) 
      (setvar 'cmdecho cmdecho) 
      (entdel cir) 
    ) 
  ) 
  (princ) 
) 
 
 
;;;选择集转为图元列表 
(defun gxl-Sel-SS->List (ss / i s) 
  (if ss 
    (repeat (setq i (sslength ss)) 
      (setq s (cons (ssname ss (setq i (1- i))) s)) 
      ) 
    ) 
  ) 
;;(gxl-Clockwise-p p1 p2 p3)判断三点是否顺时针 
(defun gxl-Clockwise-p ( p1 p2 p3 ) 
    (< 
        (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1))) 
        (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1))) 
    ) 
) 
;;pt = wcs 
;;(setq ss (GXL-SEL-SSGETBYPTRAY (getpoint) '((0 . "line,arc,*polyline")))) 
(defun gxl-sel-ssgetByptray (PT  FILTER      /    VIEWSIZE    LEN 
        P0    P2    P1    P3  ANG   DA 
        SS    PT1   PT2    S 
             ) 
  (command "_ucs" "_w") 
  (setq  viewsize (gxl-Sys-GetViewSize) 
  len   (apply 'distance viewsize) 
  p0   (car viewsize) ;_ 左下 
  p2   (cadr viewsize) ;_ 右上 
  p1   (list (car p0) (cadr p2) ) ;_ 左上 
  p3   (list (car p2) (cadr p0) ) ;_ 右下 
  ang   0 
  da   (/ pi 15) 
  ss   (ssadd) 
  ) 
  (repeat 30 
    (setq pt1 (polar pt ang len)) 
    (vl-some '(lambda (a) (setq pt2 (inters pt pt1 (car a) (cadr a)))) 
       (list (list p0 p1) (list p1 p2) (list p2 p3) (list p3 p0)) 
    ) 
    (setq s (ssget "F" (list pt pt2) filter)) 
    (if  s 
      (ssadd (cadar (ssnamex s)) ss) 
    ) 
    (setq ang (+ ang da)) 
  ) 
  (command "_ucs" "_p") 
  (if (> (sslength ss) 0) ss) 
) 
(defun gxl-Sys-GetViewSize (/ pc vh sc vw vh pmin pmax) 
  (setq pc (getvar "viewctr") 
                 vh (getvar "viewsize") 
                 sc (getvar "screensize") 
                vw (* vh (/ (car sc) (cadr sc))) 
                pmin (list (- (car pc) (* 0.5 vw)) (- (cadr pc) (* 0.5 vh))) 
                pmax (list (+ (car pc) (* 0.5 vw)) (+ (cadr pc) (* 0.5 vh))) 
           ) 
  (list pmin pmax) 
  )

q3_2006 · 发表于 2013-8-15 19:43:58

牢固发表于 2013-8-15 18:50

这个方式太厉害了，要学，谢谢G版！

chenjian2159 · 发表于 2013-8-15 20:37:42

本帖最后由 chenjian2159 于 2013-8-15 21:03 编辑

牢固发表于 2013-8-15 18:50

感谢万能的顾版，试用了下，对简单的非常好用，同时碰到了一些问题，顾版能否帮忙看看，谢谢
QQ图片20130815210124.jpg

newer · 发表于 2013-8-15 20:44:35

chenjian2159 发表于 2013-8-15 20:37
感谢万能的顾版，试用了下，对简单的非常好用，同时碰到了一些问题，顾版能否帮忙看看，谢谢

遇到的问题，还是最好直接把图片贴上来，不是谁都有时间下载附件的，很多时候看图片就知道问题在哪了。

st788796 · 发表于 2013-8-15 20:45:47

尽可能缩小时也可以完成BO来自: Android客户端

chenjian2159 · 发表于 2013-8-15 20:47:20

newer 发表于 2013-8-15 20:44
遇到的问题，还是最好直接把图片贴上来，不是谁都有时间下载附件的，很多时候看图片就知道问题在哪了。

谢谢斑竹提醒，当时想DWG文件好测试，图片的话不能对程序进行测试，而且截图怕是看不清楚

newer · 发表于 2013-8-15 20:52:51

chenjian2159 发表于 2013-8-15 20:47
谢谢斑竹提醒，当时想DWG文件好测试，图片的话不能对程序进行测试，而且截图怕是看不清楚

图片，DWG同时提供。很多时候看到你的图片，图都不用测试。我这样说，是希望你的问题能尽可能快的解决。

chenjian2159 · 发表于 2013-8-15 21:05:07

newer 发表于 2013-8-15 20:52
图片，DWG同时提供。很多时候看到你的图片，图都不用测试。我这样说，是希望你的问题能尽可能快的解决。
...

恩，可惜图片看不到清楚哦，晓东家园的氛围真好！谢谢各位！希望能顾版能解决！谢谢顾版！

newer · 发表于 2013-8-15 21:24:37

chenjian2159 发表于 2013-8-15 21:05
恩，可惜图片看不到清楚哦，晓东家园的氛围真好！谢谢各位！希望能顾版能解决！谢谢顾版！

建议你还是放弃选点自动找边界那种方式，这种方式出错概率很大。

还是你先选择好要处理的线，让程序去处理选择集。

chenjian2159 · 发表于 2013-8-15 21:36:46

newer 发表于 2013-8-15 21:24
建议你还是放弃选点自动找边界那种方式，这种方式出错概率很大。

还是你先选择好要处理的线，让程序去 ...

面对复杂的地形图，选择好处理的线的话是不是太麻烦了呢，个人感觉选点自动找边界的这种方式最适用了，不过可能就是程序比较麻烦

newer · 发表于 2013-8-15 21:54:54

chenjian2159 发表于 2013-8-15 21:36
面对复杂的地形图，选择好处理的线的话是不是太麻烦了呢，个人感觉选点自动找边界的这种方式最适用了，不 ...

实际上，你窗选一下，就给你封闭一个房子是最好不过的了，没选上的，你就单独给补上，你不希望程序出错给你乱生成吧，不要指望你点一个点，然后就出去抽烟等着了。

牢固 · 发表于 2013-8-15 22:12:12

chenjian2159 发表于 2013-8-15 21:36
面对复杂的地形图，选择好处理的线的话是不是太麻烦了呢，个人感觉选点自动找边界的这种方式最适用了，不 ...

程序不能解决一切问题！
在程序开始可以先用Bpoly点选，若生成边界则结束，没有生成边界，则采用上述程序生成边界，可解决多数问题！任何程序很难解决所有问题！上述程序的多边形越接近凸多边形，成功率越高！对于凹凸不平、狭长拐弯的多边形，上述算法则很难成功！

sicky111 · 发表于 2013-8-16 00:43:42

好像院长写过一个这样的程式。

账号		自动登录	找回密码
密码			立即注册

[求助] 第一次发帖，求助万能的晓东家园

点评

点评

点评

点评

点评

点评

点评

点评

点评

点评