大旱盼甘霖，程序盼完善！

半听可乐 · 发表于 2012-9-26 17:04:16

渴望高手帮忙中……

mugongliu · 发表于 2012-9-27 18:42:39

可以画楼梯踏步。可以扩展成点钢筋，可以扩展成多行文字

半听可乐 · 发表于 2012-12-1 17:30:43

不甘心就这样不了了之…

langjs · 发表于 2012-12-1 23:56:25

本帖最后由 langjs 于 2012-12-1 23:58 编辑

加个一个简单的扑捉
;;; -------------------------------------------------------------------------------------------------------------------
;;; ★hvlines 动态垂直水平线
;;;  By  tjuzkj  明经社区分享  http://bbs.mjtd.com/thread-91313-1-1.html
;;; -------------------------------------------------------------------------------------------------------------------
(defun c:hvlines (/ g1 g2 gr h l lst ms nearpt p p1 pt1 pt2 pt3 pt4 ptx pty v x) ; Lee Mac 2011
  (defun *error* (m)
(redraw)
(princ)
  )
  (or
*n
(setq *n 3)
  )
  (if (setq p1 (getpoint "\n指定第一个角点: "))
(progn
   (setq ms (princ "\n指定对角点 [TAB/+/-]: "))
   (while (progn
      (setq gr (grread t 15 0)
   g1 (car gr)
   g2 (cadr gr)
      )
      (cond
((= 5 g1)
   (redraw)
   (if (setq nearpt (osnap g2 "_END,_MID,CEN,NOD,QUA,INT,INS,PER")) ; 取得最近的捕捉点
   (PROGN
      (setq g2 nearpt)
      (setq h (/ (getvar "viewsize") (cadr (getvar "screensize")))
      d (getvar "pickbox")
      lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h))
      ptx (car g2)
      pty (cadr g2)
      )
      (foreach x lst
(setq pt1 (list (- ptx x) (- pty x))
      pt2 (list (+ ptx x) (- pty x))
      pt3 (list (+ ptx x) (+ pty x))
      pt4 (list (- ptx x) (+ pty x))
)
(grvecs (list 2 pt1 pt2 pt2 pt3 pt3 pt4 pt4 pt1))
      )
   )
   )
   (if *v
   (progn
      (setq h (/ (- (car g2) (car p1)) (1+ *n))
      v (- (cadr g2) (cadr p1))
      p p1
      )
      (repeat *n
(setq p (list (+ h (car p)) (cadr p) (caddr p)))
(grdraw p (list (car p) (+ v (cadr p)) (caddr p)) -1)
      )
      (setq l (list p1 (list (car p1) (+ v (cadr p1)) (caddr p1)) g2 (list (+ h (car p)) (cadr p)
            (caddr p)
            )
      )
      )
   )
   (progn
      (setq h (- (car g2) (car p1))
      v (/ (- (cadr g2) (cadr p1)) (1+ *n))
      p p1
      )
      (repeat *n
(setq p (list (car p) (+ v (cadr p)) (caddr p)))
(grdraw p (list (+ (car p) h) (cadr p) (caddr p)) -1)
      )
      (setq l (list p1 (list (+ (car p1) h) (cadr p1) (caddr p1)) g2 (list (car p) (+ v (cadr p))
            (caddr p)
            )
      )
      )
   )
   )
   (mapcar
   '(lambda (a b)
(grdraw a b 1 -1)
      )
   l
   (append
      (cdr l)
      (list (car l))
   )
   )
)
((= 2 g1)
   (cond
   ((member g2 '(45 95))
      (if (= 1 *n)
(princ (strcat "\n--> 行数达到最小2。" (substr ms 2)))
(setq *n (1- *n))
      )
   )
   ((member g2 '(43 61))
      (setq *n (1+ *n))
   )
   ((= 9 g2)
      (setq *v (not *v))
      t
   )
   )
)
((= 3 g1)
   (if (setq nearpt (osnap g2 "_END,_MID,CEN,NOD,QUA,INT,INS,PER")) ; 取得最近的捕捉点
   (setq g2 nearpt)
   )
   (if *v
   (progn
      (setq h (/ (- (car g2) (car p1)) (1+ *n))
      v (- (cadr g2) (cadr p1))
      )
      (repeat *n
(setq p1 (list (+ h (car p1)) (cadr p1) (caddr p1)))
(entmakex (list (cons 0 "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans (list (car p1) (+ v
               (cadr p1)
            )
         (caddr p1)
            ) 1 0
            )
         )
   )
)
      )
   )
   (progn
      (setq h (- (car g2) (car p1))
      v (/ (- (cadr g2) (cadr p1)) (1+ *n))
      )
      (repeat *n
(setq p1 (list (car p1) (+ v (cadr p1)) (caddr p1)))
(entmakex (list (cons 0 "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans (list (+ (car p1) h)
         (cadr p1)
         (caddr p1)
            ) 1 0
            )
         )
   )
)
      )
   )
   )
   nil
)
      )
   )
   )
)
  )
  (redraw)
  (princ)
)

smartstar · 发表于 2012-12-2 08:06:04

学习学习。

半听可乐 · 发表于 2012-12-2 09:52:08

langjs 发表于 2012-12-1 23:56
加个一个简单的扑捉
;;; ---------------------------------------------------------------------------- ...

谢谢狼大侠！能不能进一步完善成我一楼描述的那样呢？

hehoubin · 发表于 2012-12-2 13:19:07

太牛了，

weiqi · 发表于 2012-12-2 13:46:29

动态交点布块就爽了。

xyp1964 · 发表于 2012-12-2 14:36:31

;; 预览

xyp1964 · 发表于 2012-12-2 17:57:07

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

大旱盼甘霖，程序盼完善！

本帖子中包含更多资源

点评

本帖子中包含更多资源