半听可乐
发表于 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 动态垂直水平线
;;;Bytjuzkj明经社区分享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指定对角点 : "))
(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 static/image/common/back.gif
加个一个简单的扑捉
;;; ---------------------------------------------------------------------------- ...
谢谢狼大侠!能不能进一步完善成我一楼描述的那样呢?
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