Topic: draw x line in rectanges or erase object in rectagles

[dussla]

if you see addtach image , you can   rectangles
1. if i select a  rectangles , i would like to draw  cross lines (image a  ->  image b )

2. if i  select  b  rectangles ,  i would like to erase cross lines (image b -> image a)

s : all rectangle is pwline

can you understand ?
alway  good answer , thank you   
good year
 

[Fatty]

Give this a shot

Code: [Select]

(defun C:CRL (/ *error* ans coors elist ent loop osm p1 p2 p3 p4 rect ss)

  (defun *error* (msg)
    (cond
      ((or (not msg)
   (member msg
   '("console break"
     "Function cancelled"
     "quit / exit abort"
    )
   )
       )
      )
      ((princ (strcat "\nError: " msg)))
    )
    (command "undo" "e")

    (setvar "cmdecho" 1)
    (princ)
  )
  (setq osm (getvar "osmode"))

  (command "undo" "e")
  (command "undo" "be")
  (setq loop t)
  (while loop
    (while
      (or
(not (setq
       ent (entsel
     "\nSelect a rectangle or press ESC to exit loop: "
   )
     )
)
(or (not (wcmatch (cdr (assoc 0
      (setq elist (entget
    (setq rect (car ent))
  )
      )
       )
  )
  "*POLYLINE"
)
    )
    (/= 4 (cdr (assoc 90 elist)))
)
      )
       (princ "\nSeleted is not a rectangle, try again")
    )

    (if rect
      (progn
(setq coors (vl-remove-if
      (function not)
      (mapcar (function (lambda (x)
  (if (eq 10 (car x))
    (cdr x)
  )
)
      )
      elist
      )
    )
)

(setq p1 (car coors)
      p2 (cadr coors)
      p3 (caddr coors)
      p4 (cadddr coors)
)
(initget "E D")
(or (setq ans
   (getkword
     "\nDo you want to draw cross lines or erase them? [E]rase or [D]raw <D>: "
   )
    )
    (setq ans "D")
)
(if (eq "D" ans)
  (progn
    (command "line" p1 p3 "" "line" p2 p4 "")
  )
  (progn
    (setq ss (ssget "_CP" coors (list (cons 0 "LINE"))))
    (command "erase" ss "")

  )

)
      )
    )
  )
  (setq loop nil)

  (*error* nil)
  (princ)
)

~'J'~

[ronjonp]

Here is my contribution:

*Updated to work with rotated rectangles*

Code: [Select]

(defun c:test (/ ENT EPTS LL LR LST LYR PTS SS UL UR X)
  (setq ent (car (entsel)))
  (if (and ent
   (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
      )
    (progn
      (setq lyr (cdr (assoc 8 (entget ent))))
      (mapcar
'(lambda (x)
   (if (member (car x) '(10))
     (setq lst (cons (list (cadr x) (caddr x)) lst))
   )
)
(entget ent)
      )
      (if (> (length lst) 3)
(progn
  (setq ll   (car lst)
lr   (cadr lst)
ur   (caddr lst)
ul   (cadddr lst)
pts  (list (cons ll ur) (cons lr ul))
epts (list (polar ll (angle ll ur) (* (distance ll ur) 0.9))
   (polar ll (angle ll ur) (* (distance ll ur) 0.1))
   (polar lr (angle lr ul) (* (distance lr ul) 0.9))
   (polar lr (angle lr ul) (* (distance lr ul) 0.1))
     )
  )
  (if (setq ss (ssget "f" epts (list (cons 8 lyr))))
    (mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    (foreach pt pts
      (entmake (list '(0 . "LINE")
     '(100 . "AcDbEntity")
     (cons 8 lyr)
     '(100 . "AcDbLine")
     (cons 10 (car pt))
     (cons 11 (cdr pt))
       )
      )
    )
  )
)
      )
    )
  )
  (princ)
)

[CAB]

My crack at it:

Code: [Select]

;;  CAB TheSwamp.org 01.01.2008
;;  Add lines to rectangle or remove them
;;  Lines must be on same layer
;;  will add lines if locked layer but will not delete
(defun c:RecX (/ ss lst obj pts lay ss2 lst2 lines)
  (vl-load-com)
  (defun group_on2 (InpLst / OutLst)
    (while InpLst
      (setq OutLst (cons (list (car InpLst) (cadr InpLst)) OutLst))
      (setq InpLst (cddr InpLst))
    )
    OutLst
  )

  (defun is_rectangle (plst)
    (and (= (length plst) 4)
         (equal (distance (car plst) (caddr plst))
                (distance (cadr plst) (last plst))
                0.001
         )
    )
  )

  (defun get_lines (ents pts lay / dis p1 p2 elst result)
    (setq dis (distance (car pts) (caddr pts)))
    (foreach ln ents
      (setq elst (entget ln)
            p1   (cdr (assoc 10 elst))
            p2   (cdr (assoc 11 elst))
      )
      (if (and (= (cdr (assoc 8 elst)) lay)
               (equal dis (distance p1 p2) 0.00001)
               (vl-some '(lambda (x) (equal (distance p1 x)0.0 0.0001)) pts)
               (vl-some '(lambda (x) (equal (distance p2 x)0.0 0.0001)) pts)
          )
        (setq result (cons ln result))
      )
    )
    (if (= (length result) 2)
      result
    )
  )
 
  (defun make_line (p1 p2 lyr)
    (entmakex (list '(0 . "LINE")
                    '(100 . "AcDbEntity")
                    (cons 8 lyr)
                    '(100 . "AcDbLine")
                    (cons 10 p1)
                    (cons 11 p2)
              )
    )
  )

  ;;  ****   S T A R T   H E R E    ****
  (prompt "\nSelect Rectangles.")
  (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE") (-4 . "&") (70 . 1))))
  (if ss
    (progn
      (setq lst (mapcar 'vlax-ename->vla-object
                        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (foreach obj lst
        (setq pts (group_on2 (vlax-get obj 'coordinates)))
        (if (is_rectangle pts)
          (progn
            (setq lay (vla-get-layer obj))
            (if (and
                  (setq ss2 (ssget "f" pts (list '(0 . "LINE") (cons 8 lay))))
                  (setq lst2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
                  (setq lines (get_lines lst2 pts lay))
                )
              ;; got two lines for X so remove them
              (vl-catch-all-apply '(lambda ()
                (mapcar '(lambda (x) (vla-delete (vlax-ename->vla-object x))) lines)))
              (progn ; else need to create 2 lines
                (make_line (car pts) (caddr pts) lay)
                (make_line (cadr pts) (last pts) lay)
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

[dussla]

cab
there is problem ~
    error: no function definition: nil
can you test  attached file ?

app  :autocad 2004

[CAB]

Oops 
The lisp was missing this line:
(vl-load-com)
So copy the routine again as I updated it.

[dussla]

perpect ~~~~~
really  really ~
always thank you  and thank other freinds~~
good year ~  happy year~~

[CAB]

 

[efernal]

;; a routine for this...

Code: [Select]

(IF (NOT (FINDFILE "ef_001_2008.dcl"))
  (PROGN
    (SETQ _acad (FINDFILE "acad.exe")
          _acad (STRCAT (SUBSTR _acad 1 (- (STRLEN _acad) 8))
                        "ef_001_2008.dcl"
                )
          _acad (OPEN _acad "w")
    )
    (FOREACH x
             '("ef_001_2008:dialog{label=\"Rectangles\";key=\"rec\";initial_focus=\"x\";"
               "width=60;fixed_width=true;"
               ":column{alignment=centered;fixed_width=true;:spacer{height=1;}"
               ":row{alignment=centered;fixed_width=true;fixed_height=true;"
               ":column{alignment=centered;:text{label=\"Insertion point\";}"
               ":row{alignment=centered;fixed_width=true;fixed_height=true;:radio_column{key=\"r1\";"
               ":radio_button{label=\"&Above\";key=\"above\";}"
               ":radio_button{label=\"&Below\";key=\"below\";}}"
               ":spacer{width=3;}:radio_column{key=\"r2\";"
               ":radio_button{label=\"&Left\";key=\"left\";}"
               ":radio_button{label=\"&Right\";key=\"right\";}}}}"
               ":spacer{width=3;}"
               ":column{alignment=top;fixed_width=true;fixed_height=true;"
               ":edit_box{label=\"Dim &X\";key=\"x\";edit_width=12;width=22;fixed_width=true;}"
               ":edit_box{label=\"Dim &Y\";key=\"y\";edit_width=12;width=22;fixed_width=true;}}}"
               ":spacer{height=1;}"
               ":toggle{label=\"&Diagonals\";key=\"diagonals\";}:spacer{height=1;}"
               ":row{fixed_width=true;height=3;fixed_height=true;alignment=centered;"
               ":button{label=\"Abo&ut\";is_cancel=true;key=\"help\";width=16;height=2;"
               "fixed_width=true;fixed_height=true;}"
               ":button{label=\"&Cancel\";is_cancel=true;key=\"cancel\";width=16;height=2;"
               "fixed_width=true;fixed_height=true;}"
               ":button{label=\"&Proceed\";is_default=true;key=\"accept\";width=16;height=2;"
               "fixed_width=true;fixed_height=true;}}}}"
              )
      (PRINC x _acad)
    )
    (CLOSE _acad)
    (SETQ _acad nil)
  )
  (PRINC)
)
(DEFUN c:rec1 (/ dx dy dh w@ about exec verif)
  (DEFUN exec (/ p1 p2 p3 p4)
    (IF (SETQ p1 (GETPOINT "\n-> Insertion point : "))
      (PROGN (SETQ dx    (ATOF dx)
                   dy    (ATOF dy)
                   p2    (POLAR p1 0.0 dx)
                   p3    (POLAR p2 (* PI 0.5) dy)
                   p4    (POLAR p1 (* PI 0.5) dy)
                   lista (LIST p1 p2 p3 p4)
             )
             (IF (= g::ef::01_2008_high "above")
               (SETQ
                 lista (MAPCAR '(LAMBDA (x)
                                  (LIST (- (CAR x) dx) (CADR x) (CADDR x))
                                )
                               lista
                       )
               )
             )
             (IF (= g::ef::01_2008_dire "right")
               (SETQ
                 lista (MAPCAR '(LAMBDA (x)
                                  (LIST (CAR x) (- (CADR x) dy) (CADDR x))
                                )
                               lista
                       )
               )
             )
             (ENTMAKE (LIST '(0 . "LWPOLYLINE")
                            '(100 . "AcDbEntity")
                            '(100 . "AcDbPolyline")
                            '(90 . 4)
                            '(70 . 1)
                            '(43 . 0.0)
                            '(38 . 0.0)
                            '(39 . 0.0)
                            (CONS 10 (NTH 0 lista))
                            '(40 . 0.0)
                            '(41 . 0.0)
                            '(42 . 0.0)
                            (CONS 10 (NTH 1 lista))
                            '(40 . 0.0)
                            '(41 . 0.0)
                            '(42 . 0.0)
                            (CONS 10 (NTH 2 lista))
                            '(40 . 0.0)
                            '(41 . 0.0)
                            '(42 . 0.0)
                            (CONS 10 (NTH 3 lista))
                            '(40 . 0.0)
                            '(41 . 0.0)
                            '(42 . 0.0)
                      )
             )
             (IF (= g::ef::01_2008_diag "1")
               (PROGN (ENTMAKE (LIST (CONS 0 "LINE")
                                     (CONS 10 (NTH 0 lista))
                                     (CONS 11 (NTH 2 lista))
                               )
                      )
                      (ENTMAKE (LIST (CONS 0 "LINE")
                                     (CONS 10 (NTH 1 lista))
                                     (CONS 11 (NTH 3 lista))
                               )
                      )
               )
               nil
             )
             ;;
      )
      (PRINC "\n-> No insertion point...")
    )
  )
  (DEFUN about ()
    (ALERT (STRCAT "\n\tThis routine was wrote by E.Fernal\t\t\n\t"
                   "http://www.gr-acad.com.br\n\n"
           )
    )
  )
  (DEFUN verif ()
    (IF (AND (SETQ dx (GET_TILE "x"))
             (NUMBERP (READ dx))
             (NOT (ZEROP (ATOF dx)))
             (SETQ dy (GET_TILE "y"))
             (NUMBERP (READ dy))
             (NOT (ZEROP (ATOF dy)))
        )
      (DONE_DIALOG 1)
      (ALERT "\n\tPlease, verify numeric values for X and Y...\t\n")
    )
  )
  (IF (> (SETQ dh (LOAD_DIALOG "ef_001_2008.dcl")) 0)
    (IF (NEW_DIALOG "ef_001_2008" dh "" '(5 5))
      (PROGN
        (IF (NOT g::ef::01_2008_high)
          (SETQ g::ef::01_2008_high "below")
        )
        (SET_TILE g::ef::01_2008_high "1")
        (IF (NOT g::ef::01_2008_dire)
          (SETQ g::ef::01_2008_dire "left")
        )
        (SET_TILE g::ef::01_2008_dire "1")
        (IF (NOT g::ef::01_2008_diag)
          (SETQ g::ef::01_2008_diag "1")
        )
        (SET_TILE "diagonals" g::ef::01_2008_diag)
        (FOREACH x '("above" "below")
          (ACTION_TILE x "(SETQ g::ef::01_2008_high $key)")
        )
        (FOREACH x '("left" "right")
          (ACTION_TILE x "(SETQ g::ef::01_2008_dire $key)")
        )
        (ACTION_TILE "diagonals" "(SETQ g::ef::01_2008_diag $value)")
        (ACTION_TILE "help" "(about)")
        (ACTION_TILE "cancel" "(DONE_DIALOG 0)")
        (ACTION_TILE "accept" "(verif)")
        (SETQ w@ (START_DIALOG))
        (UNLOAD_DIALOG dh)
        (COND ((= w@ 0) (PRINC "\n-> Cancelled..."))
              (T (exec))
        )
      )
      nil
    )
    (ALERT "Error:\n\n\tDialog file could not be loaded...\t\n\n")
  )
  (PRINC)
)
(PRINC "\n-> Type REC1 and press enter to run...")
(PRINC)
<edit: code tags addd by CAB>

[efernal]

;; sorry, fixing an error

(IF (NOT (FINDFILE "ef_001_2008.dcl"))
  (PROGN
    (SETQ _acad (FINDFILE "acad.exe")
          _acad (STRCAT (SUBSTR _acad 1 (- (STRLEN _acad) )
                        "ef_001_2008.dcl"
                )
          _acad (OPEN _acad "w")
    )
    (FOREACH x
             '("ef_001_2008:dialog{label=\"Rectangles\";key=\"rec\";initial_focus=\"x\";"
               "width=60;fixed_width=true;"
               ":column{alignment=centered;fixed_width=true;:spacer{height=1;}"
               ":row{alignment=centered;fixed_width=true;fixed_height=true;"
               ":column{alignment=centered;:text{label=\"Insertion point\";}"
               ":row{alignment=centered;fixed_width=true;fixed_height=true;:radio_column{key=\"r1\";"
               ":radio_button{label=\"&Above\";key=\"above\";}"
               ":radio_button{label=\"&Below\";key=\"below\";}}"
               ":spacer{width=3;}:radio_column{key=\"r2\";"
               ":radio_button{label=\"&Left\";key=\"left\";}"
               ":radio_button{label=\"&Right\";key=\"right\";}}}}"
               ":spacer{width=3;}"
               ":column{alignment=top;fixed_width=true;fixed_height=true;"
               ":edit_box{label=\"Dim &X\";key=\"x\";edit_width=12;width=22;fixed_width=true;}"
               ":edit_box{label=\"Dim &Y\";key=\"y\";edit_width=12;width=22;fixed_width=true;}}}"
               ":spacer{height=1;}"
               ":toggle{label=\"&Diagonals\";key=\"diagonals\";}:spacer{height=1;}"
               ":row{fixed_width=true;height=3;fixed_height=true;alignment=centered;"
               ":button{label=\"Abo&ut\";is_cancel=true;key=\"help\";width=16;height=2;"
               "fixed_width=true;fixed_height=true;}"
               ":button{label=\"&Cancel\";is_cancel=true;key=\"cancel\";width=16;height=2;"
               "fixed_width=true;fixed_height=true;}"
               ":button{label=\"&Proceed\";is_default=true;key=\"accept\";width=16;height=2;"
               "fixed_width=true;fixed_height=true;}}}}"
              )
      (PRINC x _acad)
    )
    (CLOSE _acad)
    (SETQ _acad nil)
  )
  (PRINC)
)
(DEFUN c:rec1 (/ dx dy dh w@ about exec verif)
  (DEFUN exec (/ p1 p2 p3 p4)
    (IF (SETQ p1 (GETPOINT "\n-> Insertion point : "))
      (PROGN (SETQ dx    (ATOF dx)
                   dy    (ATOF dy)
                   p2    (POLAR p1 0.0 dx)
                   p3    (POLAR p2 (* PI 0.5) dy)
                   p4    (POLAR p1 (* PI 0.5) dy)
                   lista (LIST p1 p2 p3 p4)
             )
             (IF (= g::ef::01_2008_high "above")
               (SETQ
                 lista (MAPCAR '(LAMBDA (x)
                                  (LIST (CAR x) (- (CADR x) dy) (CADDR x))
                                )
                               lista
                       )
               )
             )
             (IF (= g::ef::01_2008_dire "right")
               (SETQ
                 lista (MAPCAR '(LAMBDA (x)
                                  (LIST (- (CAR x) dx) (CADR x) (CADDR x))
                                )
                               lista
                       )
               )
             )
             (ENTMAKE (LIST '(0 . "LWPOLYLINE")
                            '(100 . "AcDbEntity")
                            '(100 . "AcDbPolyline")
                            '(90 . 4)
                            '(70 . 1)
                            '(43 . 0.0)
                            '(38 . 0.0)
                            '(39 . 0.0)
                            (CONS 10 (NTH 0 lista))
                            '(40 . 0.0)
                            '(41 . 0.0)
                            '(42 . 0.0)
                            (CONS 10 (NTH 1 lista))
                            '(40 . 0.0)
                            '(41 . 0.0)
                            '(42 . 0.0)
                            (CONS 10 (NTH 2 lista))
                            '(40 . 0.0)
                            '(41 . 0.0)
                            '(42 . 0.0)
                            (CONS 10 (NTH 3 lista))
                            '(40 . 0.0)
                            '(41 . 0.0)
                            '(42 . 0.0)
                      )
             )
             (IF (= g::ef::01_2008_diag "1")
               (PROGN (ENTMAKE (LIST (CONS 0 "LINE")
                                     (CONS 10 (NTH 0 lista))
                                     (CONS 11 (NTH 2 lista))
                               )
                      )
                      (ENTMAKE (LIST (CONS 0 "LINE")
                                     (CONS 10 (NTH 1 lista))
                                     (CONS 11 (NTH 3 lista))
                               )
                      )
               )
               nil
             )
             ;;
      )
      (PRINC "\n-> No insertion point...")
    )
  )
  (DEFUN about ()
    (ALERT (STRCAT "\n\tThis routine was wrote by E.Fernal\t\t\n\t"
                   "http://www.gr-acad.com.br\n\n"
           )
    )
  )
  (DEFUN verif ()
    (IF (AND (SETQ dx (GET_TILE "x"))
             (NUMBERP (READ dx))
             (NOT (ZEROP (ATOF dx)))
             (SETQ dy (GET_TILE "y"))
             (NUMBERP (READ dy))
             (NOT (ZEROP (ATOF dy)))
        )
      (DONE_DIALOG 1)
      (ALERT "\n\tPlease, verify numeric values for X and Y...\t\n")
    )
  )
  (IF (> (SETQ dh (LOAD_DIALOG "ef_001_2008.dcl")) 0)
    (IF (NEW_DIALOG "ef_001_2008" dh "" '(5 5))
      (PROGN
        (IF (NOT g::ef::01_2008_high)
          (SETQ g::ef::01_2008_high "below")
        )
        (SET_TILE g::ef::01_2008_high "1")
        ;;
        (IF (NOT g::ef::01_2008_dire)
          (SETQ g::ef::01_2008_dire "left")
        )
        (SET_TILE g::ef::01_2008_dire "1")
        ;;
        (IF (NOT g::ef::01_2008_diag)
          (SETQ g::ef::01_2008_diag "1")
        )
        (SET_TILE "diagonals" g::ef::01_2008_diag)
        ;;
        (FOREACH x '("above" "below")
          (ACTION_TILE x "(SETQ g::ef::01_2008_high $key)")
        )
        (FOREACH x '("left" "right")
          (ACTION_TILE x "(SETQ g::ef::01_2008_dire $key)")
        )
        (ACTION_TILE "diagonals" "(SETQ g::ef::01_2008_diag $value)")
        (ACTION_TILE "help" "(about)")
        (ACTION_TILE "cancel" "(DONE_DIALOG 0)")
        (ACTION_TILE "accept" "(verif)")
        (SETQ w@ (START_DIALOG))
        (UNLOAD_DIALOG dh)
        (COND ((= w@ 0) (PRINC "\n-> Cancelled..."))
              (T (exec))
        )
      )
      nil
    )
    (ALERT "Error:\n\n\tDialog file could not be loaded...\t\n\n")
  )
  (PRINC)
)
(PRINC "\n-> Type REC1 and press enter to run...")
(PRINC)

[efernal]

better user this file...
e.fernal