AutoCAD二次开发lisp

ZJBLOVE · 发表于 2007-1-26 20:07:15

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

连续模设计相关技术及AutoCAD二次开发lisp
lisp源程序，大家可以pp,我可以帮改改

ZJBLOVE · 发表于 2007-1-26 20:10:20

;;;将选取的图形拷贝到指定的图层 Command:k
;;;2004-01-08    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:K(/ en2 en3 yesno)
  (setvar "cmdecho" 0)
  (princ "请选取欲拷贝的图形:")
  (setq en2 (ssget))          ;选取欲拷贝的图形
  (if (= en2 nil)
(sub-quit)
(sub-kkk en3 chklay YESNO)
)
  )

(defun sub-kk()
  (command "copy" en2 ""  "0,0" "")
  (command "change" en2 "" "p" "la" en3 "")
  (princ "\n所选图已拷贝到图层")
  (prin1 en3)
  (prin1))

(defun sub-kkk (en3 chklay yesno)
  (setq en3 (getstring "请输入图层名:"))
  (if (= en3 "")
(progn (sub-quit))
(progn (setq chklay (tblsearch "layer" en3))
         (if (= chklay nil)
         (progn(setq yesno(getstring "\n层不存在，是否建立<N>:"))
                  (if       (or (= yesno "Y") (= yesno "y"))
                  (progn
                     (command "layer" "n" en3 "")
                     (sub-kk)
                  )
                  (progn (sub-quit))
                  )
         )
         (progn (sub-kk))
         )
)
  )
)

ZJBLOVE · 发表于 2007-1-26 20:12:08

AutoCAD二次开发lisp 我可以帮写

jim1006 · 发表于 2007-1-28 12:04:33

楼主可否发些实用的源程序,供大家分享.

lan8563270 · 发表于 2008-11-6 12:50:28

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

dchunf · 发表于 2008-11-15 09:42:50

腾讯娱乐讯：华表与百花双料影后李冰冰29日现身上海，为其蜡像揭幕而来，李冰冰的蜡像在经历半年的专业制作后，于今日光采示人！这是李冰冰继一年之内连夺华表和百花影后之后，获得的又一项尊贵殊荣，她的加入让蜡像馆更加熠熠生辉然而宣传稿中一再强调的内地首位入住的女星身份，却遭到各方质疑，李冰冰表示这只是误解而已。
李冰冰蜡像造型特地参照了她在领取华表奖最佳女主角奖项时所穿的服装造型。因蜡像传神地表达了李冰冰清丽的气质和无法抗拒的魅力，入驻蜡像馆“爱心小屋”区恰如其分。李冰冰从影十数年，塑造了众多脍炙人口的角色。尤其是近几年，随着电影《天下无贼》、《云水谣》和《功夫之王》的热映，更让这位勤奋的艺人跨入事业巅峰。作为一位全面发展的艺人，李冰冰没有止步于现有的成就，更全身心地投入公益事业、灌录唱片，在各个领域都获得了不错的成绩。
您最关注的站
诛仙攻略美容减肥网东方女性黄冈论坛中国美容

wangbing.li · 发表于 2008-11-17 15:48:28

楼主不简单！我用过了！是最实用的CAD外挂件了！

ysryc99001 · 发表于 2010-9-21 13:23:27

请帮忙修改以下程序，谢谢！
defun c

OF (/ a b b1 p1 d pckbox)
(setq d 20 p1 nil pee (/ pi 2)e 3 pckbox (getvar "pickbox"

line " ")
(if(= #parof nil)(setq #parof(/(getvar "viewsize")10)))
(princ "\n当前偏移量 <")(princ #parof)
(setq answer(getstring ">: "))
(if (/= (atof answer) 0.0)(setq #parof(atof answer)))
(princ line)
(setvar "pickbox" pckbox)
(setq ent(entsel "\n拾取线： "))
(setvar "pickbox" 2)
(setq point(cadr ent))
(princ line)
(setq side(getpoint "\n拾取要偏移的一方： "))
(setq dist(distance side point))(setq ang(angle side point))
(if(or(or(< ang 0.78)(> ang 5.5))(and(> ang 2.35)(< ang 3.92)))
(setq ang(- 0 ang))(setq ang(- pi ang))
);end if
(setq other(polar point ang dist))
(command "offset" #parof ent side ent other "")
(entdel(car ent))

(setvar "pickbox" pckbox)
(prin1)
)

ysryc99001 · 发表于 2010-9-21 13:29:44

还有一个程序
(defun mp ()
  (setvar "cmdecho" 0)
  (command "ucs" "w")
  (setq i 0)
  (winwin)
  (win)
  (vl-load-com)
  (setq acadobj    (vlax-get-acad-object)
acadpro    (vla-get-preferences acadobj)
acaddis    (vla-get-output acadpro)
acadtool (vla-get-defaultoutputdevice acaddis)
output    (vla-get-defaultplotstyletable acaddis)
  )
  (setq *acadobject* (vlax-get-acad-object)
*acaddocument* (vla-get-activedocument *acadobject*)
*mspace*    (vla-get-modelspace *acaddocument*)
  )
  (setq pop_list (list acadtool))
  (setq pop1_list '("acad.ctb"
      "acad.stb"
      "Add-A-Plot Style Table Wizard"
      "Fill Patterns.ctb"
      "Grayscale.ctb"
      "monochrome.ctb"
      "monochrome.stb"
      "Sample Floor Plan_Architectural.stb"
      "Sample Floor Plan_Base.stb"
      "Sample Floor Plan_Electrical.stb"
      "Sample Floor Plan_Lighting.stb"
      "Screening 25%.ctb"
      "Screening 50%.ctb"
      "Screening 75%.ctb"
      "Screening 100%.ctb"
   )
  )
  (dcl)
  (setq sss (ssget))
  (setq n 0)
  (setq i 0)
  (repeat (sslength sss)
(setq en (ssname sss n))
(setq vl-en (vlax-ename->vla-object en))
(vla-getboundingbox vl-en 'minext 'maxext)
(setq point1 (vlax-safearray->list minext))
(setq point2 (vlax-safearray->list maxext))
(setq en_date (entget en))
(setq ABC (strcase (cdr (assoc 0 en_date))))
(if (= ABC "INSERT")
   (liling)
)

(setq n (1+ n))
  )
  (cond ((= data "0")
   (princ (strcat "\nゴ" (itoa i) "眎家ㄣ瓜"))
)
((= data "1")
   (princ (strcat "\n 共打印了" (itoa i) "模具图纸"))
)
  )
  (princ)
)

(defun acad1 ()
  (command "-plot"    "Y" ""    acadtool       siz2 ""
   fang    ""    "w" point1 point2 ""    ""       ""
   output ""    "" ""    ""    ""
   )
  (setq i (1+ i))
)

(defun acad2 ()
  (command "-plot"    "Y" ""    acadtool       siz1 ""
   fang    ""    "w" point1 point2 ""    ""       ""
   output ""    "" ""    ""    ""
   )
  (setq i (1+ i))
)

(defun acad3 ()
  (command "-plot"    "Y" ""    acadtool       siz1 ""
   fang    ""    "w" point1 point2 ""    ""       ""
   output ""    "" ""    ""    ""
   )
  (setq i (1+ i))
)

(defun acad4 ()
  (command "-plot"    "Y" ""    acadtool       siz1 ""
   fang    ""    "w" point1 point2 ""    ""       ""
   output ""    "" ""    ""    ""
   )
  (setq i (1+ i))
)

(defun acad5 ()
  (command "-plot"    "Y" ""    acadtool       siz2 ""
   fang    ""    "w" point1 point2 ""    ""       ""
   output ""    "" ""    ""    ""
   )
  (setq i (1+ i))
)

(defun winwin ()
  (setq dat_file (findfile "Big5orGB.dat"))
  (setq ff (open dat_file "r"))
  (setq data1 (read-line ff))
  (setq data (substr data1 1 1))
  (close ff)
  (princ)
)

(defun liling ()
  (setq size (strcase (cdr (assoc 2 en_date))))
  (cond ((and (= size "A3") (= th "AA")) (acad1))
((and (= size "A4") (= th "AA")) (acad2))
((and (= size "A4") (= th "BB")) (acad4))
((and (= size "A3") (= th "BB")) (acad3))
((and (= size "A3") (= th "CC")) (acad1))
  )
)
(defun win ()
  (setq dat_file (findfile "paper_size.dat"))
  (setq paper (open dat_file "r"))
  (setq siz1 (read-line paper))
  (setq siz2 (read-line paper))
  (close paper)
  (princ)
)

(defun dcl ()
  (setq dcl_id (load_dialog "mp"))
  (cond
((= data "0") (new_dialog "mpf" dcl_id))
((= data "1") (new_dialog "mpj" dcl_id))
  )
  (action_tile "AA" "(done_dialog 1)")
  (action_tile "BB" "(done_dialog 2)")
  (action_tile "CC" "(done_dialog 3)")
  (show_list "pop" pop_list)
  (show_list "pop1" pop1_list)
  (action_tile "pop" "(sub_pop $value)")
  (action_tile "pop1" "(sub_pop1 $value)")
  (ty_list1)
  (set_tile "LP" "1")
  (set_tile "edit_x" "0.00")
  (set_tile "edit_Y" "0.00")
  (action_tile "LP" "(ty_list1)")
  (action_tile "PL" "(ty_list2)")
  (setq dd (start_dialog))
  (cond ((= dd 1) (setq th "AA"))
((= dd 2) (setq th "BB"))
((= dd 3) (setq th "CC"))
  )
)

(defun sub_pop (vvs)
  (set_tile "plotstyle" (nth (atoi vvs) pop_list))
)

(defun sub_pop1 (vvs)
  (set_tile "acadstyle" (nth (atoi vvs) pop1_list))
)
(defun ty_list1 ()
  (setq ddtype 1)
  (setq fang "Portrait")
  (show_sld "kimage" "sb")
)

(defun ty_list2 ()
  (setq ddtype 2)
  (setq fang "Landscape")
  (show_sld "kimage" "sb1")
)

(defun show_sld (key sld)
  (setq x (dimx_tile key))
  (setq y (dimy_tile key))
  (start_image key)
  (fill_image 0 0 x y -15)
  (slide_image 0 0 x y sld)
  (end_image)
)
(defun show_list (key newlist)
  (start_list key)
  (mapcar 'add_list newlist)
  (end_list)
)

(vlax-add-cmd "mp" 'mp)

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

全站		goto3d 说: 此次SW竞赛获奖名单公布如下，抱歉晚了，版主最近太忙：一等奖：塔山817；二等奖：a9041、飞鱼；三等奖：wx_dfA5IKla、xwj960414、bzlgl、hklecon；请以上各位和版主联系，领取奖金！！！	2022-03-11
系统		[系统通知] 平台第一个项目外包——项目拼多；正式上线，欢迎各单位个人有外包、设计、采购、加工需求的，在此寻找更牛的解决方案	2021-07-01

通知

[原创] AutoCAD二次开发lisp

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。