绘制云线源码

langjs · 发表于 2012-1-20 02:06:25

本帖最后由 langjs 于 2012-1-20 12:41 编辑

一个小小的程序，没啥难度，中间的那个while循环还是有点意思的。
自己觉得手感还不错，就发上来给大家看看

;;; 绘制矩形云线    命令：yun    by:langjs
;;; __________________________________________
(princ "\n 绘制矩形云线命令：yun")
(defun c:yun (/ #err99 $orr c pt pt2 r snap)
  (defun #err99 (s)
(command ".UNDO" "E")
(setvar "CECOLOR" c)
(setvar "OSMODE" snap)
(setq *error* $orr)
  )
  (setq $orr *error*)
  (setq *error* #err99)
  (setvar "CMDECHO" 0)
  (command ".UNDO" "BE")
  (setvar "OSMODE" 0)
  (setq c (getvar "CECOLOR")
snap (getvar "OSMODE")
  )
  (while (progn
(if (null rbak)
   (setq rbak (* 0.8 (getvar "DIMSCALE") (getvar "DIMTXT")))
)
(initget "A C ")
(if (= (setq pt (getpoint "\n指定第一个角点或 [弧长(A)/颜色(C)]："))
"A"
      )
   (setq r (getreal (strcat "\n指定弧长 <" (rtos rbak 2 3) ">:")))
   (if (= pt "C")
      (setq cdbak (cdr (car (acad_truecolordlg '(62 . 1)))))
   )
)
(not (= (type pt) 'list))
  )
  )
  (if r
(setq rbak r)
  )
  (if cdbak
(command "color" cdbak)
(command "color" 1)
  )
  (while (not (setq pt2 (getcorner pt "\n指定另一个角点："))))
  (command "_rectang" pt pt2)
  (command "_revcloud" "A" rbak rbak "O" "" (entlast) "N")
  (setvar "CECOLOR" c)
  (setvar "OSMODE" snap)
  (command ".UNDO" "E")
  (setq *error* $orr)
  (princ)
)

qcw911 · 发表于 2012-1-20 08:20:47

不好意思我点支持结果点错了

byghbcx · 发表于 2012-1-20 10:11:11

revcloud命令后直接点对象不就行了吗？

yoyoho · 发表于 2012-1-20 10:32:30

感谢 langjs 楼主分享学习!

T_T · 发表于 2012-1-20 17:15:37

谢谢楼主, 收藏学习

nt8011 · 发表于 2012-4-14 10:19:57

langjs 楼主，程序在设定颜色时，选“bylayer”出错误，能否请大师修改！

nt8011 · 发表于 2012-4-16 10:00:02

按照langjs 楼主的提示，已解决。谢谢！

l18c19 · 发表于 2013-8-28 21:12:08

程序在设定颜色时，选“bylayer”出错误。是否将：
   (if (= pt "C")
   (setq cdbak (cdr (car (acad_truecolordlg '(62 . 1)))))
修改为：
   (if (= cdbak 256)
   (setq cdbak "BYLAYER") )
请langjs大师，最好能将1楼的内容更新下，就好啦！

594826903 · 发表于 2019-12-17 17:58:23

不错支持支持！

sdbaijiao · 发表于 2020-1-3 10:29:28

谢谢楼主的分享

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

绘制云线源码

评分

本帖被以下淘专辑推荐:

相关帖子

点评