明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1108|回复: 3

求一个云线的lisp

[复制链接]
发表于 2015-6-2 19:13 | 显示全部楼层 |阅读模式
10明经币
-->1. 框选生成云线,云线图层为当前日期,每天云线颜色不一样
-->2. 图层非打印,云线绘制完点击外面某点,绘制直线,
    如果不输批注,按空格,则默认文字为(某月某日修改)
-->3. 启动命令R1(框选画云线),R2(选择对象云线),R12(设置云线宽度)

附件: 您需要 登录 才可以下载或查看,没有账号?注册
发表于 2015-6-2 19:13 | 显示全部楼层

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

发表于 2017-11-8 14:54 | 显示全部楼层
求程序```````````
回复

使用道具 举报

发表于 2017-12-28 17:08 | 显示全部楼层
凑了一个,自己改下适合自己用的就行了
(defun c:yun (/ #err99 $orr c pt pt2 r snap)  ;云线原作者 langjs
  (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 "layer" "s" "gm3" "")
(command "_rectang" pt pt2)
(command "layer" "s" "gm1" "")
  (command "_revcloud" "A" rbak rbak "O" "" (entlast) "N")
(setvar "CECOLOR" c)
;--文字标示
(setq va (getvar "lunits"))   
(setq date0 (menucmd "m=$(edtime,$(getvar,date),日期:YYYY-MO-DD:)" ))
(if (= va 2)     (progn        (setq vaa 3)       (setq vab 6)     )      
(progn        (setq vaa 0.125)       (setq vab 0.25)     )   )
(PROGN        
(setq le1 (getpoint "\n Specify the first point: "))      
(setq le2 (getpoint "\n Specify the second point: "))
(setq str (getstring "\n输入说明:"))  
(command "qleader"   le1 le2  "" "50"  date0  str  "" )   
)
(setq ssa (ssget "X" '((0 . "LWPOLYLINE") (8 . "gm3"))))
(command "erase" ssa "" )
  (setvar "OSMODE" snap)
  (command ".UNDO" "E")
  (setq *error* $orr)
  (princ)
)

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 17:45 , Processed in 0.176848 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表