wmz 发表于 2012-6-27 20:50:09

请教如何实现延伸到指定矩形框内的多段线,矩形多边形,圆。。。。。。等等。

请教如何实现延伸到指定矩形框内的多段线,矩形多边形,圆。。。。。。等等。如用(setq s (ssget "wp" (list p1 p2 p3 p4 )))窗选,则延伸到该窗口内的线段等将不被选取,如何解决?(似乎用cp也不行)

Andyhon 发表于 2012-6-27 20:56:50

cp也不行
请举实例

yanguangfei 发表于 2012-6-27 21:01:24

是正矩形框吗?如果是试试C或W

Gu_xl 发表于 2012-6-27 22:07:18

(setq s (ssget "cp" (list p1 p2 p3 p4 )))
就可以,但是要保证选择点在屏幕显示范围内才行!

longer1000 发表于 2012-6-28 08:18:28

帮顶中!!!!!!!!!!!

wmz 发表于 2012-6-28 09:00:49

这是我的程序:
;画网格
(defun c:dwgx(/ e ss blxs zdx p0 p1 p2 pp1 pp2 pp3 pp4 x0 y0 x1 y1 xx0 yy0 xx1 yy1 xp1 yp1 xjl yjl K0 G0 xf yf xfgs yfgs)
    (setq blc (atof blc0) TZG (atof TZG0) TZK (atof TZK0));;;TZG----每幅图高度;TZK----每幅图宽度。一般为50*50cm
    (setq blxs (/ blc 1000.0))
    (setqzdx (* 50 blxs))
   (command "zoom" "e")
   (command "regen")
   (setvar "osmode" 0)
   (setq extmin (getvar "extmin"))
   (setq extmax (getvar "extmax"))
   (setq y0 (car extmin) x0 (cadr extmin))
   (setq y1 (car extmax) x1 (cadr extmax))
   (cond ((>= (* (- (/ y0 1000.0) (fix (/ y0 1000.0))) 1000.0) TZK)
   (setq yy0 (+ (* (fix (/ y0 1000.0)) 1000.0) TZK))
         )
((< (* (- (/ y0 1000.0) (fix (/ y0 1000.0))) 1000.0) TZK)
   (setq yy0 (* (fix (/ y0 1000.0)) 1000.0))
)
   )
   (cond ((>= (* (- (/ x0 1000.0) (fix (/ x0 1000.0))) 1000.0) TZG)
          (setq xx0 (+ (* (fix (/ x0 1000.0)) 1000.0) TZG))
         )
((< (* (- (/ x0 1000.0) (fix (/ x0 1000.0))) 1000.0) TZG)
          (setq xx0 (* (fix (/ x0 1000.0)) 1000.0))
)
   )
   (cond ((>= (* (- (/ y1 1000.0) (fix (/ y1 1000.0))) 1000.0) TZK)
(setq yy1 (+ (* (fix (/ y1 1000.0)) 1000.0) TZK))
      )
      ((< (* (- (/ y1 1000.0) (fix (/ y1 1000.0))) 1000.0) TZK)
(setq yy1 (* (fix (/ y1 1000.0)) 1000.0))
      )
   )
   (cond ((>= (* (- (/ x1 1000.0) (fix (/ x1 1000.0))) 1000.0) TZG)
(setq xx1 (+ (* (fix (/ x1 1000.0)) 1000.0) TZG))
       )
       ((< (* (- (/ x1 1000.0) (fix (/ x1 1000.0))) 1000.0) TZG)
(setq xx1 (* (fix (/ x1 1000.0)) 1000.0))
       )   
    )
   (setqyJL (- y1 yy0) xJL (- x1 xx0))
   (setq yfgs (/ yJL TZK)
xfgs (/ xJL TZG)
    )
    (if (< (* yfgs TZK) yJL)(setq yfgs (+ yfgs 1)))
    (if (< (* xfgs TZG) xJL)(setq xfgs (+ xfgs 1)))
    (setq yf (+ (fix yfgs) 1) xf (+ (fix xfgs) 1))
      (command "LAYER" "m" "TK""on" "TK" "C" 7 "TK" "L" "continuous" "TK" "")
       (setq G0 (- 0 TZG) nnn 0)
    (repeat xf
       (setq G0 (+ G0 TZG) K0 (- 0 TZK) xp1 (+ xx0 G0))
   (repeat yf
       (setq k0 (+ k0 TZK))
       (setq yp1 (+ yy0 k0))
       (setq pp1 (list yp1 xp1) pp2 (list (+ yp1 TZK) xp1) pp3 (list (+ yp1 tzk) (+ xp1 TZG)) pp4 (list yp1 (+ xp1 TZG)))
       (setq ss nil)
       (setq ss (ssget "wp" (list pp1 pp2 pp3 pp4 pp1)))
      ; (setq ss (ssget "cp" (list pp1 pp2 pp3 pp4 pp1)))
      (if ss
(progn
            (setq p1 (list yp1 xp1) p2 (list (+ yp1 TZK) (+ xp1 TZG)))
            (setq p0 (list (+ yp1 (/ TZK 2.0)) (+ xp1 (/ TZG 2.0))) nnn (+ nnn 1))
   (command "text" "m" p0 zdx "359" (rtos nnn 2 0))
   (setq e (entlast))
            (bm e "121110")
            (command "rectang" p1 p2)
            (setq e (entlast))
            (bm e "121100")
   (setq ss nil)
)

       );;end if
   )
    )
   );;;end defun
以下是用wp选择的图

以下是用cp选择的图

本人要的图纸效果(以下是wp选择后用手工添加上的图

wmz 发表于 2012-6-29 19:00:13

希望得到高手的指教!

ZZXXQQ 发表于 2012-6-30 09:11:44

先算出坐标,最后再画方框写字。

(defun c:dwgx(/ e ss blxs zdx p0 p1 p2 pp1 pp2 pp3 pp4 x0 y0 x1 y1 xx0 yy0 xx1 yy1 xp1 yp1 xjl yjl K0 G0 xf yf xfgs yfgs)
(setq blc (atof blc0) TZG (atof TZG0) TZK (atof TZK0));;;TZG----每幅图高度;TZK----每幅图宽度。一般为50*50cm
(setq blxs (/ blc 1000.0))
(setq zdx (* 50 blxs))
(command "zoom" "e" "regen")
(setvar "osmode" 0)
(setq extmin (getvar "extmin"))
(setq extmax (getvar "extmax"))
(setq y0 (car extmin) x0 (cadr extmin))
(setq y1 (car extmax) x1 (cadr extmax))
(if (>= (* (- (/ y0 1000.0) (fix (/ y0 1000.0))) 1000.0) TZK)
(setq yy0 (+ (* (fix (/ y0 1000.0)) 1000.0) TZK))
(setq yy0 (* (fix (/ y0 1000.0)) 1000.0))
)
(if ((>= (* (- (/ x0 1000.0) (fix (/ x0 1000.0))) 1000.0) TZG)
(setq xx0 (+ (* (fix (/ x0 1000.0)) 1000.0) TZG))
(setq xx0 (* (fix (/ x0 1000.0)) 1000.0))
)
(if ((>= (* (- (/ y1 1000.0) (fix (/ y1 1000.0))) 1000.0) TZK)
(setq yy1 (+ (* (fix (/ y1 1000.0)) 1000.0) TZK))
(setq yy1 (* (fix (/ y1 1000.0)) 1000.0))
)
(if ((>= (* (- (/ x1 1000.0) (fix (/ x1 1000.0))) 1000.0) TZG)
(setq xx1 (+ (* (fix (/ x1 1000.0)) 1000.0) TZG))
(setq xx1 (* (fix (/ x1 1000.0)) 1000.0))
)
(setq yJL (- y1 yy0) xJL (- x1 xx0))
(setq yfgs (/ yJL TZK)
       xfgs (/ xJL TZG))
(if (< (* yfgs TZK) yJL) (setq yfgs (1+ yfgs)))
(if (< (* xfgs TZG) xJL) (setq xfgs (1+ xfgs)))
(setq yf (1+ (fix yfgs)) xf (1+ (fix xfgs)))
(command "LAYER" "m" "TK" "")
(setq G0 (- TZG) nnn 0 ptlst (list))
(repeat xf
(setq G0 (+ G0 TZG) K0 (- TZK) xp1 (+ xx0 G0))
(repeat yf
   (setq k0 (+ k0 TZK))
   (setq yp1 (+ yy0 k0))
   (setq pp1 (list yp1 xp1)
         pp2 (list (+ yp1 TZK) xp1)
         pp3 (list (+ yp1 tzk) (+ xp1 TZG))
         pp4 (list yp1 (+ xp1 TZG)))
   (setq ss nil)
   (setq ss (ssget "c" pp1 pp3))
; (setq ss (ssget "wp" (list pp1 pp2 pp3 pp4 pp1)))
; (setq ss (ssget "cp" (list pp1 pp2 pp3 pp4 pp1)))
   (if ss (progn
    (setq p1 (list yp1 xp1) p2 (list (+ yp1 TZK) (+ xp1 TZG)))
    (setq p0 (list (+ yp1 (/ TZK 2.0)) (+ xp1 (/ TZG 2.0))) nnn (1+ nnn))
;    (command "text" "m" p0 zdx "359" (itoa nnn))
;    (setq e (entlast))
;    (bm e "121110")
;    (command "rectang" p1 p2)
;    (setq e (entlast))
;    (bm e "121100")
    (setq ptlist (cons (list p1 p2 p0 nnn) ptlist))
    (setq ss nil)
   ));;end if
)
)
(foreach x ptlist
(command "TEXT" "M" (caddr x) zdx "359" (itoa (last x)))
(bm (entlast) "121110")
(command "RECTANG" (car x) (cadr x))
(bm (entlast) "121100")
)
)

wmz 发表于 2012-6-30 19:41:27

ZZXXQQ 发表于 2012-6-30 09:11 static/image/common/back.gif
先算出坐标,最后再画方框写字。


十分感谢ZZXXQQ版主的帮助!我太弱智,因为我在另一程序中曾遇到与此几乎完全同样的问题,我也是先计算后绘图解决的,而到这里就犯糊涂了。还是版主技高一筹。再次表示万分的感谢!

yunkongming 发表于 2016-1-29 09:44:02

wmz 发表于 2012-6-28 09:00 static/image/common/back.gif
这是我的程序:
;画网格
(defun c:dwgx(/ e ss blxs zdx p0 p1 p2 pp1 pp2 pp3 pp4 x0 y0 x1 y1 xx0 yy0...

希望得到高手的指教!
页: [1]
查看完整版本: 请教如何实现延伸到指定矩形框内的多段线,矩形多边形,圆。。。。。。等等。