怎么没有二次开发的？

ZWX168

比如比例问题，图纸比例不是1：1，单行文字，多行文字的字高要改变，表注箭头、字高要改变，画图中途改变比例，所有的要改变样式吗？
有没有一个小程序一次搞定？

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：BL，按提示Scale factor:输入值，即可改变全部文字的字高
注意：标题块、图框最好作成图块，不然它们中的字字高也变了！！！！！！！！
% R! y* l  V  A0 G
(defun c:bl()
(setq val (getreal "Scale factor: "))
;;默认文字字高4.0mm
5 L, {- [3 i. Z% X# I! D1 g/ n+ f: [(setq high (* 4 val))
(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
5 }( M$ z/ L, m6 C3 h5 i(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
/ R& G' g% R7 ~0 _) U1 y4 H(entmod DIMENSION)
: u% M- u! X) O0 G; L* P(setq test (+ 1 test))
- B' q  O/ p% t* n3 V)
(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
(setq N (- (sslength ssl) 1))
2 _7 P7 m( [2 w+ q& a4 ]  q) h(setq test 0)
(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
(entmod DIMENSION)
9 M% l# A2 q" I) ~: T/ T(setq test (+ 1 test))
)
)

cad

确实比较少。原来论坛有相关版块的，因为参与的人少，撤掉了。现在作为一个分类
% R+ w9 T0 B8 o5 D. h0 a' Xhttp://www.askcad.com/bbs/forumd ... r=type&typeid=4

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：DIMBL，按提示Scale factor:输入值，即可改变全部标注文字的字高、箭头的大小。
/ k  k9 ~# U" \- A6 L) ~' }
, X3 T! Z9 p) b(defun cIMbl()
- \' J7 E1 z6 z& E(setq val (getreal "Scale factor: "))
* m; d% j& E/ @& @(setvar "DIMSCALE" val)
(setvar "DIMASZ" 2)
(setvar "DIMTXT" 3.5)
) I# X' Z* k! v+ w(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(command "dim" "update" ssl "" "exit")
$ q, u0 |3 G2 F" @(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
( O" O, M% S8 K7 p  x5 `! K5 u(command "dim" "update" ssl "" "exit")
! U$ `; g4 L- U7 t/ C& M: o)

ZWX168

剖面线由于比例不统一，有的太密，有的太稀。下面的程序可以把全部剖面线比例统一。
+ h2 m4 ]! n! D5 R! D! H
, }% m- M; V8 v8 U$ {& r) L0 c(defun c:HCbl()
5 L# L7 j: m9 _: l2 i(setq val (getreal "Scale factor: "))
(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
+ g1 p" c' A/ C: j% \' h5 A(setq N (- (sslength ssl) 1))
. D/ T7 r, d: G: q7 m" V(setq test 0)
" H3 T% [5 N/ y- L' a( Y, s(while (<= test  N )
  F& Y- B3 R" ^(setq SS NIL)
3 |9 Z5 m+ n' B, \" V(setq ss (ssadd))
' `9 S; f! e+ ~(ssadd (ssname ssl test) SS)
(command "-hatchedit" ss "" "" val "")
(setq test (+ 1 test))
% a, V3 p/ B1 i2 A" \" X)
)
- s" @7 [$ O- o* W2 }; _
) }. |9 y' e+ S+ ^砖要抛没了！！！！！！！
玉还不出来吗？

:'(

ZWX168

我做图时习惯把虚线、点划线、双点划线分别放在单独的图层，由于粘贴的图形导致同一线形的线形比例不同，很难看，下面的程序可以把选中的线所在图层的全部图线的线形比例统一

# U/ x0 d0 O, K: [& S1 ?(defun cSbl()
(setq  DIMENSION (entget (car (entsel "lease choose an object:" ))))
(setq val (getreal "New linetype Scale : "))
1 y5 V! L* K3 p- T(setq TEXT (cdr (assoc '8 DIMENSION)))
: W/ O2 |1 M  x(setq ssl (ssget "X" (list (cons 8 TEXT))))
(command "ChPROP" ssl "" "S"  val "")
)

ZWX168

有的时候，打剖面线，有些中心线、虚线、双点划线、序号指引线捣乱，要多选几个剖面区域，下面的程序可以把那些捣乱的线所在的图层冻结。

(defun c:FreezeMe()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
(setq TEXT (cdr (assoc '8 DIMENSION)))
4 B. q# Z' D* w6 ]2 y' q(setq Cname (getvar "clayer"))
* Z! p3 C0 R6 B9 ](if  (/= Cname TEXT)
& ^' _' O  \0 d, i5 M(command "layer" "F" TEXT "")
(progn
! f7 o5 {7 C5 j8 [(setq templist (tblnext "LAYER" T))
3 M4 p8 w1 s2 {1 u(while templist
( [3 t# b7 a6 m/ G/ ?(setq name (cdr (assoc 2 templist)))
(if  (/= name TEXT)
(progn
& F/ u) a# K1 A$ b(setvar "clayer" name)
. d3 N# W, E$ z1 x' ^(command "layer" "F" TEXT "")
$ `. G& y6 i! w5 O; C) B(setq templist nil)
)
8 c6 s# H9 r5 R2 `2 A' t3 J6 l(setq templist (tblnext "LAYER"))
7 |& @3 ~& q0 }, O/ q3 X)
)
)
! `) i4 F' Z; r+ Z1 ]+ Y)
)

ZWX168

这个程序是楼上的反向选择，冻结所选实体所在图层以外的全部图层
3 ]7 G: U8 \" e- D* l
1 k$ \' y: |% W" m# v, l9 w(defun c:FreezeOther()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
: d3 R# y& N3 N( [, k5 _(setq TEXT (cdr (assoc '8 DIMENSION)))
(setvar "clayer" TEXT)
; v3 @$ g5 D8 J3 Y  X(setq Cname (getvar "clayer"))
& z% z1 E7 {1 q0 O8 F0 C' `' K$ Y(command "layer" "F" TEXT "")
3 X7 V7 m" r- I(setq templist (tblnext "LAYER" T))
' p3 O5 x: }; {7 ?; |7 W(while templist
  s# N5 U9 k4 b9 `& W) r(setq name (cdr (assoc 2 templist)))
(if  (/= name TEXT) (command "layer" "F" name ""))
' Y! E3 t; l0 V3 P  N* p! y( K(setq templist (tblnext "LAYER"))
)
% J5 k' F' s$ Y7 v6 r)

ZWX168

解冻全部图层

(defun c:unFreezeAll()
" g- F  w9 ?$ }5 n(setq templist (tblnext "LAYER" T))
- y5 g' z  P% O* D/ X8 l(while templist
(setq name (cdr (assoc 2 templist)))
(command "layer" "T" name "")
(setq templist (tblnext "LAYER"))
)
(command "_regenall")
$ S& j9 c) o% e$ i- S)

cad

下次回复有代码的时候，勾选“禁用 Smilies”，就不会出现六楼那样的笑脸符号

ZWX168

重画剖面线：如果剖面线的边界发生变化，如拉伸后剖面线没有与边界同步调整，下面的程序可以“修复剖面线”。只对简单的图形有效（《=3 个分开的图形）。当然图形得是封闭的，原来的剖面线位置变化不大。
& q% z/ F" r+ z7 V
(defun C:hath()
(setq  DIMENSION  (car (entsel)))
(setq SSL NIL)
(setq ssL (ssadd))
! L  e* Y- _, Z(ssadd DIMENSION SSL)
(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
% u0 w1 e) q6 o. ~" E! t(if (<= no 3)
(progn
(if (= no 1)
(progn
(setq l1 (length DIMENSION))
* z. \9 E4 \8 g, ^5 e2 N( u(setq p1 (cdr (nth (- l1 1) DIMENSION)))
( n+ d% `: W; m5 h! |( ?; A, _0 K(command "-bhatch" p1 "")
' _5 n' B7 V3 M- s; l0 B(command "_erase" SSL "")
))
(if (= no 2)
5 ^; m4 [& o& ~) K- }9 ?* N8 d(progn
(setq l1 (length DIMENSION))
( U6 ?' H) w' [2 l! N5 S(setq p1 (cdr (nth (- l1 1) DIMENSION)))
, u- }6 f, [* R(setq p2 (cdr (nth (- l1 2) DIMENSION)))
; }$ m8 a0 s1 v, i( o(command "-bhatch" p1 p2 "")
(command "_erase" SSL "")
. g/ ]  r# ~6 _))
! z4 i8 l/ i  |* I0 G* I1 y  A(if (= no 3)
& g7 T9 Y5 B) a(progn
(setq l1 (length DIMENSION))
* |+ f* E  N  j1 z6 d(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(setq p3 (cdr (nth (- l1 3) DIMENSION)))
( x8 U: I8 C$ v. @2 o6 J: ~% _(command "-bhatch" p1 p2 p3 "")
) }) o5 G/ `+ p6 q" Y, U(command "_erase" SSL "")
; L, o" r3 @0 N0 F))
))
" P3 @6 f+ b4 H" i(if (> no 3)(prompt "请选择简单图形！"))
# [+ ~8 j! H9 ?9 G9 l)

ZWX168

楼上的程序“修复”的剖面线没有继承原来的属性。
更正以下，没有继承图层属性。也没有必要。
/ `+ Q% C/ s  i1 e: K! ^
(defun C:hath()
(setq  DIMENSION  (car (entsel)))
  w& P; E6 K( E, B$ g$ T(setq SSL NIL)
(setq ssL (ssadd))
(ssadd DIMENSION SSL)
6 p7 _" A8 H% l$ q(setq  DIMENSION (entget DIMENSION))
3 N+ d3 ^2 |! B# b* z; u" P(setq no (cdr (assoc '98 DIMENSION)))
3 ^2 l5 E/ p* q- E9 q8 n& O(setq name (cdr (assoc '2 DIMENSION)))
9 u: a0 d. A* `- ?) K(setq Scale (cdr (assoc '41 DIMENSION)))
(setq angle (cdr (assoc '52 DIMENSION)))
(setq angle (angtos  angle 0 0))
(if (<= no 3)
(progn
' u1 a6 H- R. s- k$ q(if (= no 1)
(progn
5 o% S& F- R' L( C(setq l1 (length DIMENSION))
6 ~4 t+ `8 |- z/ J(setq p1 (cdr (nth (- l1 1) DIMENSION)))
$ f  ?- t# ^/ b! e, _9 Y(command "-bhatch" "P"  name Scale angle p1"")
" T$ F) ^  V+ _$ g(command "_erase" SSL "")
))
/ ]' M$ `1 b8 j. u  p5 P; O(if (= no 2)
(progn
- g3 L0 W$ ]$ P7 Y1 q% C9 o3 f(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
2 |* K" n) Q4 O. C6 K- C9 z9 g8 M6 o* ?(setq p2 (cdr (nth (- l1 2) DIMENSION)))
' Q; Q( J; Q6 s  x; s(command "-bhatch" "P"  name Scale angle p1 p2 "")
(command "_erase" SSL "")
3 Z) c" d6 G; Y" F# N))
2 E# W9 n# h) E(if (= no 3)
9 a, I" R; l8 k(progn
(setq l1 (length DIMENSION))
* @  o3 I6 Q8 q6 `, T# U(setq p1 (cdr (nth (- l1 1) DIMENSION)))
4 Y- D2 d- m. [1 Z4 f0 R0 }7 l- i) \1 @(setq p2 (cdr (nth (- l1 2) DIMENSION)))
# A' k# s7 h* D* Y3 J(setq p3 (cdr (nth (- l1 3) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1 p2 p3 "")
8 B' p1 j& q4 F4 E0 U( T(command "_erase" SSL "")
  d% `& x- @! y6 O4 [))
+ Y* H6 J1 B& ]. K6 f" x))
(if (> no 3)(prompt "请选择简单图形！"))
1 O1 ^! B1 h  V6 j% _)

ZWX168

习惯上CAD画图要分若干个图层，例如："1文字"、"2标注"、"3剖面"等，下面的程序可以把不同分类的实体分别放到各自的图层中，“各就各位！”
(defun c:movelayer ()
  g  k" u1 I0 `6 H(setq layname "1文字")
(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
0 i+ ?4 E' r% f, ]! X* |9 U2 n0 I/ A3 h(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
3 E; X) ?/ E: H% D" A4 f% ?6 c7 L. C5 \(setq layname "2标注")
' P$ a4 o. _0 S5 j% b(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
4 j" T8 f; j/ }5 E# |) d( q(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
; G2 J% y9 m0 M  h! p(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
  f+ t$ a; x6 U: L(setq layname "3剖面")
; y! {9 x+ w4 |6 O(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
) A5 \, K1 f3 K/ s4 F)

ZWX168

下面的程序可以根据选择的对象显示不同的对话框。
前提是确定已经加载了ddchprop.LSP和  ddmodify.LSP
(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddchprop")
3 Y' `4 P; K- G6 d3 h' v(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddmodify")
4 V# v* C: q& v' K3 W+ G8 ~1 C

, B6 n- q* ^8 x* n0 L& ]
(defun C:ai_propchk()
' t# J* M& B7 d, `8 Q; z6 c0 k9 n+ V$ ]' R(setq SSL (SSGET))
(IF (= (sslength ssL) 1)
: J4 H- v' s/ b( m5 K(progn
4 g& T4 q( ?' _" N(setq  DIMENSION (entget (ssname ssL 0)))
: V. O9 I/ x0 [( q& |! S3 m) T(setq TEXT (cdr (assoc '0 DIMENSION)))
(setq set 0)
(if (= TEXT  "TEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
(if (= TEXT  "MTEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
(if (= TEXT  "DIMENSION") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
(if (= TEXT  "HATCH") (progn (COMMAND "_hatchedit" SSL) (setq set 1)))
+ P+ k3 o+ Z# x# g& J# G(if (= TEXT  "INSERT") (progn (COMMAND "_ddatte" SSL) (setq set 1)))
* e0 b8 O, O& V( m" Z(if (= set 0) (ddmodify (ssname ssL 0)))
# P3 a4 y& L8 S4 z0 m)
1 n8 U8 s8 [8 U- h( X. L)
(IF (> (sslength ssL) 1) (ddchprop ssl))
)

ZWX168

图纸中标注的尺寸，有的是标注值与实际值不等，这样的尺寸有时会带来麻烦，下面的程序可以把
" H( {, Z$ y$ W" m3 X标注值与实际值不等的尺寸指出来，用“150号颜色”显示它。
(defun C:CHDIM()
(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(setq N (- (sslength ssl) 1))
; B. u8 e6 |4 h1 }# K. T  Y  P(setq test 0)
(while (<= test  N )
; N; x" C# D& D2 `. b(setq DIMENSION (ENTGET (ssname ssl test)))
(setq Dimval (cdr (assoc '1 DIMENSION)))
(if (/= Dimval "")
! C: N6 J9 Q6 P! z8 E: C$ B9 }9 ?(progn
) Y3 ]% |  h! a% t( G; q(setq len (strlen Dimval))
4 V) b7 j1 r) i3 F1 u& n(setq test2 1)
(setq key 0)
(while (<= test2  (- len 1))
(if (= (substr Dimval test2 2) "<>")(setq key 1))
(setq test2 (+ 1 test2))
)
2 Z; Y+ c2 n( S4 I4 V% M(if (= key 1)
(progn
(setq SS NIL)
(setq ss (ssadd))
(setq DIMENSION (ssname ssl test))
(ssadd DIMENSION SS)
(command "change" ss "" "p" "c" "150" "")
2 l" E6 n& h8 S" b. z: Q)
& ^* ^' t( C2 H)
)
+ {% F, u! k) l  m( A)
(setq test (+ 1 test))
)
)