Jump to content

need lisp for rectangle cross inside


git_thailand

Recommended Posts

code 1 = make rectangle cross (x) inside (different layer)

code 2 = make (+)cross center line inside by multi select rectangle and delete.

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by paulmcz
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

.... 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.

Link to comment
Share on other sites

  • 2 weeks later...

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...

Link to comment
Share on other sites

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.

 

But most of us would also pay someone to do those things for us, not expect it for free...

 

Not hatin', just sayin'.

Link to comment
Share on other sites

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 by ILoveMadoka
rev
Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...