git_thailand Posted October 2, 2011 Share Posted October 2, 2011 code 1 = make rectangle cross (x) inside (different layer) code 2 = make (+)cross center line inside by multi select rectangle and delete. Quote Link to comment Share on other sites More sharing options...
paulmcz Posted October 2, 2011 Share Posted October 2, 2011 code 1: (defun c:cr (/ lt ename b c sn sn1 sn2 p1 p2 p3 p4 f d d1 d2 d3 a1 a2 a3 a4 p5 p6 p7 p8 p9 p10 sc ocl la ) (command "cmdecho" (getvar "cmdecho")) (setq lt "center") (if (= (tblsearch "ltype" lt) nil) (command "-linetype" "l" lt "acad.lin" "") ) (setq ocl (getvar "clayer")) (setq la "different") (if (tblsearch "layer" la) (command "-layer" "s" la "") (command "-layer" "m" la "") ) (princ "\n Select rectangles: ") (setq ss (ssget '((-4 . "<and") (0 . "LWPOLYLINE") (70 . 1) (90 . 4) (-4 . "and>") ) ) sn (sslength ss) sn1 sn ) (repeat sn (setq sn2 (1- sn1) ename (ssname ss sn2) b (entget ename) b (member (assoc 10 b) b) ) (while (member (assoc 10 b) b) (setq c (append c (list (cdr (assoc 10 b)))) b (cdr b) b (member (assoc 10 b) b) ) ) (setq f 0.125 d 0.12 p1 (nth 0 c) p2 (nth 1 c) p3 (nth 2 c) p4 (nth 3 c) c nil d1 (/ (distance p1 p2) 2) d2 (/ (distance p2 p3) 2) d3 (if (> d1 d2) (* d1 0.12) (* d2 0.12) ) a1 (angle p1 p2) a2 (angle p2 p1) a3 (angle p2 p3) a4 (angle p3 p2) p5 (polar p1 a1 d1) p6 (polar p5 a4 d3) p7 (polar p6 a3 (+ (* d2 2) (* d3 2))) p8 (polar p2 a3 d2) p9 (polar p8 a1 d3) p10 (polar p9 a2 (+ (* d1 2) (* d3 2))) sc (* (+ d1 d2) f) sn1 sn2 ) (entmake (list (cons 0 "LINE") (cons 8 la) (cons 6 lt) (cons 62 3) (cons 10 p6) (cons 11 p7) (cons 48 sc) (cons 210 (list 0.0 0.0 1.0)) ) ) (entmake (list (cons 0 "LINE") (cons 8 la) (cons 6 lt) (cons 62 3) (cons 10 p9) (cons 11 p10) (cons 48 sc) (cons 210 (list 0.0 0.0 1.0)) ) ) ) (setvar "clayer" ocl) (princ) ) for the code 2, delete what? the rectangles? Quote Link to comment Share on other sites More sharing options...
git_thailand Posted October 2, 2011 Author Share Posted October 2, 2011 code 1 = x cross no + cross (set rectangle in 0 layer , x cross in 1 layer ) Code 2 = code 1 you , but i want make cross line in cont line (no centerline linetype) in multi select rectangle and delete rec Quote Link to comment Share on other sites More sharing options...
paulmcz Posted October 2, 2011 Share Posted October 2, 2011 (edited) Here you go (code 1 => cr, code 2 => crd). (defun c:cr (/ lt ename b c sn sn1 sn2 p1 p2 p3 p4 f d d1 d2 d3 a1 a2 a3 a4 p5 p6 p7 p8 p9 p10 sc ocl la ent lar ) (command "cmdecho" (getvar "cmdecho")) (setq lt "center") (if (= (tblsearch "ltype" lt) nil) (command "-linetype" "l" lt "acad.lin" "") ) (setq ocl (getvar "clayer")) (setq la "1" lar "0") (if (tblsearch "layer" la) (command "-layer" "s" la "") (command "-layer" "m" la "") ) (princ "\n Select rectangles: ") (setq ss (ssget '((-4 . "<and") (0 . "LWPOLYLINE") (70 . 1) (90 . 4) (-4 . "and>") ) ) sn (sslength ss) sn1 sn ) (repeat sn (setq sn2 (1- sn1) ename (ssname ss sn2) ent (entget ename) b (member (assoc 10 ent) ent) ) (while (member (assoc 10 b) b) (setq c (append c (list (cdr (assoc 10 b)))) b (cdr b) b (member (assoc 10 b) b) ) ) (setq f 0.125 d 0.12 p1 (nth 0 c) p2 (nth 1 c) p3 (nth 2 c) p4 (nth 3 c) c nil d1 (/ (distance p1 p2) 2) d2 (/ (distance p2 p3) 2) d3 (if (> d1 d2) (* d1 0.12) (* d2 0.12) ) a1 (angle p1 p2) a2 (angle p2 p1) a3 (angle p2 p3) a4 (angle p3 p2) p5 (polar p1 a1 d1) p6 (polar p5 a4 d3) p7 (polar p6 a3 (+ (* d2 2) (* d3 2))) p8 (polar p2 a3 d2) p9 (polar p8 a1 d3) p10 (polar p9 a2 (+ (* d1 2) (* d3 2))) sc (* (+ d1 d2) f) sn1 sn2 ) (entmake (list (cons 0 "LINE") (cons 8 la) (cons 6 lt) ;(cons 62 3) (cons 10 p1) (cons 11 p3) (cons 48 sc) (cons 210 (list 0.0 0.0 1.0)) ) ) (entmake (list (cons 0 "LINE") (cons 8 la) (cons 6 lt) ;(cons 62 3) (cons 10 p2) (cons 11 p4) (cons 48 sc) (cons 210 (list 0.0 0.0 1.0)) ) ) (if (= "0" (cdr (assoc 8 ent))) () (progn (setq ent (subst (cons 8 lar) (assoc 8 ent) ent)) (entmod ent) ) ) ) (setvar "clayer" ocl) (princ) ) (defun c:crd (/ lt ename b c sn sn1 sn2 p1 p2 p3 p4 f d d1 d2 d3 a1 a2 a3 a4 p5 p6 p7 p8 p9 p10 sc ocl la ent ) (command "cmdecho" (getvar "cmdecho")) (setq lt "center") (if (= (tblsearch "ltype" lt) nil) (command "-linetype" "l" lt "acad.lin" "") ) (setq ocl (getvar "clayer")) (setq la "1") (if (tblsearch "layer" la) (command "-layer" "s" la "") (command "-layer" "m" la "") ) (princ "\n Select rectangles: ") (setq ss (ssget '((-4 . "<and") (0 . "LWPOLYLINE") (70 . 1) (90 . 4) (-4 . "and>") ) ) sn (sslength ss) sn1 sn ) (repeat sn (setq sn2 (1- sn1) ename (ssname ss sn2) ent (entget ename) b (member (assoc 10 ent) ent) ) (while (member (assoc 10 b) b) (setq c (append c (list (cdr (assoc 10 b)))) b (cdr b) b (member (assoc 10 b) b) ) ) (setq f 0.125 d 0.12 p1 (nth 0 c) p2 (nth 1 c) p3 (nth 2 c) p4 (nth 3 c) c nil d1 (/ (distance p1 p2) 2) d2 (/ (distance p2 p3) 2) d3 (if (> d1 d2) (* d1 0.12) (* d2 0.12) ) a1 (angle p1 p2) a2 (angle p2 p1) a3 (angle p2 p3) a4 (angle p3 p2) p5 (polar p1 a1 d1) p6 (polar p5 a4 d3) p7 (polar p6 a3 (+ (* d2 2) (* d3 2))) p8 (polar p2 a3 d2) p9 (polar p8 a1 d3) p10 (polar p9 a2 (+ (* d1 2) (* d3 2))) sc (* (+ d1 d2) f) sn1 sn2 ) (entmake (list (cons 0 "LINE") (cons 8 la) ;(cons 6 lt) ;(cons 62 3) (cons 10 p6) (cons 11 p7) ;(cons 48 sc) (cons 210 (list 0.0 0.0 1.0)) ) ) (entmake (list (cons 0 "LINE") (cons 8 la) ;(cons 6 lt) ;(cons 62 3) (cons 10 p9) (cons 11 p10) ;(cons 48 sc) (cons 210 (list 0.0 0.0 1.0)) ) ) (entdel ename) ) (setvar "clayer" ocl) (princ) ) Edited October 2, 2011 by paulmcz Quote Link to comment Share on other sites More sharing options...
git_thailand Posted October 3, 2011 Author Share Posted October 3, 2011 thankyou. paulmcz plese make code = create rec and xcross Quote Link to comment Share on other sites More sharing options...
paulmcz Posted October 3, 2011 Share Posted October 3, 2011 Since you are not describing what you want (or need) clearly, I or someone else could be writting the code after code for days and it still wouldn't be good enough for you. I think that now is the good time for you to start learning how to write your own code. What you want right now should be fairly easy to learn for the start. To start, go here. If you get stuck, ask your question here and I or someone else will help you. If you are not going to express clearly and in detail what problem you are having, don't expect that someone will read your mind. See here how to make a post so you have a chance to get some answers. Also, see help files in AutoCAD's vlide section (type vlide on the command line and go to Help menu). Good luck. Quote Link to comment Share on other sites More sharing options...
pBe Posted October 3, 2011 Share Posted October 3, 2011 .... I think that now is the good time for you to start learning how to write your own code. What you want right now should be fairly easy to learn for the start.... Good luck. Ditto Believe me. Autolisp is not that hard to learn. Quote Link to comment Share on other sites More sharing options...
ILoveMadoka Posted October 17, 2011 Share Posted October 17, 2011 Writing basic Autolisp is not that difficult but I still am amazed by the code produced by those here... I am still quite the novice (especially among many here) but there's a lot of code here that even trying to analyze what is happening in a particular program is beyond my understanding. While there is truth in needing to learn at least some basics most of us wouldn't tell someone, learn to fix your own car or learn to do your own plumbing, learn to do your own carpentry or sheet rock or electrical work. NONE of those things are hard IF you know how... NONE are beyond being "learn-able" either... I try to figure stuff out before asking for help but many applications are quite advanced for the majority of us. I do realize there is a difference between "I need help" and "I need someone to write a particular program for me." I am not the only one who has done both.. Please have mercy on us less knowledgeable ones or we will be afraid to ask for help... Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted October 17, 2011 Share Posted October 17, 2011 most of us wouldn't tell someone, learn to fix your own car orlearn to do your own plumbing, learn to do your own carpentry or sheet rock or electrical work. But most of us would also pay someone to do those things for us, not expect it for free... Not hatin', just sayin'. Quote Link to comment Share on other sites More sharing options...
ILoveMadoka Posted October 17, 2011 Share Posted October 17, 2011 (edited) Well said... I know when I make a request I'm not "expecting" anything. I'm "hoping and praying" that someone will have mercy! Reminds me of when I first bought my truck.... Every weekend it seemed I'd get a call "Whatcha doing this weekend??" Some of us just do not possess the aptitude to attain unto advanced programming. I aspire to it but I barely passed Algebra and do not have a good head for logic... I frequent here because of the generosity of those who know more than I. I, for one, and am ever grateful for all the help you and others have so graciously provided through the site! =^.^= Edited October 17, 2011 by ILoveMadoka rev Quote Link to comment Share on other sites More sharing options...
tuankt14b6 Posted October 21, 2011 Share Posted October 21, 2011 this lisp error " crd" Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.