;试用以下程序
(defun c:test()
(setq bcsjb '(("A1" 9549.31 6977.53 7180.75 7155.97 11015.11)
("A2" 10814.00 7468.76 6367.24 7155.97 11072.28)
("A3" 4563.99 6621.92 6732.4 7155.97 10938.9)
("A4" 4911.96 6422.68 11368.55 7538.32 10932.26)
)
)
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "_undo" "be")
(setq ljc 0.0)
(setq i 0)
(setq n (length bcsjb))
(repeat n
(setq sjb (nth i bcsjb))
(mapcar 'set '(zfc c a d e b) sjb)
(setq CosA (/ (- (+ (* b b) (* c c)) (* a a)) 2.0 b c))
(setq jdA (atan (/ (sqrt (- 1.0 (* CosA CosA))) CosA )))
(setq p1 (list ljc 0))
(setq p2 (mapcar '+ p1 (list c 0)))
(setq p3 (polar p1 jdA b))
(setq CosB (/ (- (+ (* b b) (* e e)) (* d d)) 2.0 b e))
(setq jdB (atan (/ (sqrt (- 1.0 (* CosB CosB))) CosB)))
(setq p4 (polar p1 (+ jdA jdB) e))
(setq pmid (mapcar '(lambda(x y)(* 0.5 (+ x y))) p1 p3))
(command "_pline" p1 p2 p3 p4 "c")
(command "_text" pmid 1000 0 zfc)
(setq ptmin (apply 'mapcar (cons 'min (list p1 p2 p3 p4))))
(setq ptmax (apply 'mapcar (cons 'max (list p1 p2 p3 p4))))
(setq dxy (mapcar '- ptmax ptmin))
(setq ljc (+ ljc (car dxy) 2000.0))
(setq i (1+ i))
)
(command "_undo" "e")
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
)
cad四边形展开lisp_批量绘制四边形 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
