viking11 发表于 2011-6-28 08:46:28

求助：LISP实现图示图形

详附件，谢谢，QQ362349621

zhynt 发表于 2011-6-28 10:26:24

本帖最后由 zhynt 于 2011-6-28 10:40 编辑


(defun c:ty ()
(setq ss (entsel "\n选择图形:"))
(setq ent (entget (car ss)))
;;;获取矩形顶点表
(setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) ent))
(setq ptlist (mapcar 'cdr ptlist))
(setq ptlist
(vl-sort ptlist
    (function
      (lambda (e1 e2)
      (< (car e1) (car e2))
      )
    )
)
)
(setq xmin (car (car ptlist)))
(setq ptlist
(vl-sort ptlist
    (function
      (lambda (e1 e2)
      (< (cadr e1) (cadr e2))
      )
    )
)
)
(setq ymin (cadr (car ptlist)))
(setq ptlist
(vl-sort ptlist
    (function
      (lambda (e1 e2)
      (> (car e1) (car e2))
      )
    )
)
)
(setq xmax (car (car ptlist)))
(setq ptlist
(vl-sort ptlist
    (function
      (lambda (e1 e2)
      (> (cadr e1) (cadr e2))
      )
    )
)
)
(setq ymax (cadr (car ptlist)))
(setq pta (list xmin ymin)
ptb (list xmax ymax)
)
    (setq ptc (list xmin ymax)
ptd (list xmax ymin)
)
(setq h (getreal "\n高度:"))
(setq pt1 (polar ptb (/ (* 34.0 pi) 180) (* 1.5 h))
pt2 (polar ptd (/ (* 34.0 pi) 180) (* 1.5 h))
pt3 (polar ptc (/ (* 146.0 pi) 180) (* 1.5 h))
pt4 (polar pta (/ (* 146.0 pi) 180) (* 1.5 h))
pt5 (polar ptc (/ pi 2) (* 1.5 h))
pt6 (polar ptb (/ pi 2) (* 1.5 h))
)
(command "pline" "non" pta ptd pt2 pt1"A" "ce" ptb pt6 "L" pt5 "A" "ce" ptc pt3 "L" pt4 "C")
)

viking11 发表于 2011-6-28 11:21:20

谢谢ZHYNT，向雷锋同志学习

viking11 发表于 2011-6-28 11:42:49

C:\1.jpg，zhynt兄，此处画出有错误，红色虚线为修正后

zhynt 发表于 2011-7-3 15:08:05

回复 viking11 的帖子

看不到图???

viking11 发表于 2011-7-4 11:29:51

红线为正确，视基准图形不同，有时会偏移较大

本帖最后由 viking11 于 2011-7-4 11:31 编辑

file:///c:/1.jpg

zhynt 发表于 2011-7-4 14:44:30

依然看不到图，有人看见吗？

daidong013 发表于 2011-7-4 15:04:11

看不到！~~肯定没传上！~~

ljpnb 发表于 2011-7-4 16:43:28

本帖最后由 ljpnb 于 2011-7-5 12:00 编辑


没注意少了两个自定义函数

viking11 发表于 2011-7-5 08:33:03

回复 zhynt 的帖子

上传的图片可能只有我自己能看到，拉到附件里了，麻烦ZHYNT有时间给看看
页: [1] 2
查看完整版本: 求助：LISP实现图示图形