004 发表于 2014-5-11 02:19:29

[源码]测绘画房子

本帖最后由 004 于 2014-5-11 02:37 编辑


;;;测绘画房子
;;;四个，三个，两个边长画房子
;;;wkq00420140402
(defun c:df (/ e pt pt2 pt3 ang fxang fxline)
    (defun *error* (msg)
    (princ "\n取消!")
    (if e
    (entdel e)
)
    (command ".undo" "end")
    (setq *error* nil)
)
    (if (>= (setq os (getvar "osmode")) 16384)
    (setvar "osmode" (- os 16384))
    (setvar "osmode" (+ os 16384))
)

(setq pt (getpoint "\n拾取房角点："))
(setq pt2 (getpoint pt "\n拾取房边方向线："))
(entmake (list '(0 . "LINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbLine")
       (cons 10 pt)
       (cons 11 (polar pt (angle pt pt2) 1000))
       '(62 . 1)
       '(210 0. 0. 1.)
       )
    )
(setq dist (getdist pt "\n输入房边长："))
(entdel (entlast))
(setq startpt pt)
(setq ang (angle pt pt2))
(command "line" pt (setq pt2 (polar pt ang dist)) "")
(setq co 2)
(setq elst '())
(setq elst (cons (entlast) elst))
(defun fxline(pta ptb /)
    (setq ang (angle pta ptb))
    (cond ((and (>= ang 0) (< ang (/ pi 2)))
   (setq fxang (+ ang (/ pi 2)))
    ) ;_0-90
    ((and (>= ang (/ pi 2)) (< ang pi))
   (setq fxang (- ang (/ pi 2)))
    ) ;_90-180
    ((and (>= ang pi) (< ang (/ (* 3 pi) 2)))
   (setq fxang (+ (- ang pi) (/ pi 2)))
    ) ;_180-270
    ((and (>= ang (/ (* 3 pi) 2)) (< ang (* 2 pi)))
   (setq fxang (- (- ang pi) (/ pi 2)))
    ) ;_270-0
    )
    (setq ptc (polar ptb fxang 1000))
    (entmake (list '(0 . "LINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbLine")
       (cons 10 ptb)
       (cons 11 ptc)
       '(62 . 1)
       '(210 0. 0. 1.)
       )
    )
    (setq e (entlast))
)
(fxline pt pt2)
(setq xh T)

(while (and xh
       (/= (setq world
      (getstring
      "\n测绘画房,负距离反方向线绘制[闭合(C)/延长(Y)/撤销(U)]<房边长>： "
      )
   )
   ""
       )
   )
    (if(/= 0.0 (setq num (atof world)))
      (if (>= num 0.0)
(progn
    (entdel e)
    (command "line" pt2 (setq pt3 (polar pt2 fxang num)) "")
    (setq elst (cons (entlast) elst))
    (fxline pt2 pt3)
   
    (setq pt2 pt3)
)
(progn
    (if (> fxang pi)
      (setq fxang (- fxang pi))
      (setq fxang (+ fxang pi))
    )
    (entdel e)
    (command "line"
       pt2
       (setq pt3 (polar pt2 fxang (abs num)))
       ""
    )
    (setq elst (cons (entlast) elst))
    (fxline pt2 pt3)
   
    (setq pt2 pt3)
)
      )
      (cond
((= (strcase world) "C")
   (setq xh nil)
   (setq elst (cons (entlast) elst))
   (entdel e)
   (command "line" pt3 startpt "")
)
((= (strcase world) "Y")
   (if (/= (setq world (getstring "\n请输入延长距离：")) "")
   (if (> (setq num (atof world)) 0.0)
       (progn
         (entdel e)
         (setq pt3 (polar pt2 ang num))
         (if (> (setq co (1+ co)) 5)
   (setq co 2)
   )
         (entmake(list '(0 . "LINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbLine")
            (cons 10 pt2)
            (cons 11 pt3)
            (cons 62 co)
            '(210 0. 0. 1.)
      )
         )

         (fxline pt2 pt3)

         (setq pt2 pt3)
       )
       (princ "   延长距离只能为正实数!")
   )
   )
)
((= (strcase world) "U")
   (entdel e) ;_删辅助线
   (entdel (car elst)) ;_删线
   (setq elst (cdr elst))
   (setq laste (car elst))
   (setq el (entget laste))
   (setq pt (cdr (assoc 10 el)))
   (setq pt2 (cdr (assoc 11 el)))
   (fxline pt pt2)
   (setq pt2 pt3)
)
;;;(t
;;;   
;;;)
      )
    )
)
(if (= world "")
    (entdel e)
)
    (if (>= (setq os (getvar "osmode")) 16384)
    (setvar "osmode" (- os 16384))
    (setvar "osmode" (+ os 16384))
)

(princ)
)

杜阳 发表于 2014-5-11 08:20:30

j继续了大师我是个初学者   支持你了

lioun4105 发表于 2018-3-23 08:13:53

拿来试一试，谢谢

月之圣痕 发表于 2018-4-8 17:45:12

学习当中。

happy336 发表于 2019-10-15 12:01:46

谢谢分享，支持
页: [1]
查看完整版本: [源码]测绘画房子