« previous next »
Pages: [1] |   Go Down

Author Topic: bad function: "0"  (Read 3264 times)

0 Members and 1 Guest are viewing this topic.

Adesu

  • Guest
bad function: "0"
« on: January 10, 2007, 03:12:09 AM »
Hi Alls,
I got problem to solve my code,as the figure for you,create a line,circle,arc,point,xline etc in your acad session,then use my code
Code: [Select]
; cnxl is stand for Check Non Xref by Layer
;        Design by  : Adesu <Ade Suharna>
;        Email      : mteybid@yuasabattery.co.id
;        Homepage   : http://www.yuasa-battery.co.id
;        Create     : 08 January 2007
;        Program no.: 0508/01/2007
;        Edit by    : Adesu   10/01/2007   1).add remove
;        ******* UNDER CONSTRUCTION *******

(defun RemoveDuplicateStrings (stringlist / newlist) ; by kwb 20050221
  (foreach var stringlist
    (if
      (not (vl-position var newlist))
      (setq newlist (cons var newlist))
      )
    )
  (reverse newlist)
  )
(defun remove (str /)
  (setq remove (vl-string-trim "()" (vl-princ-to-string str)))
  remove
  )

(defun c:cnxl (/ cnt laya layc laye layl laylw layp lays layx lst
       lst_arc lst_circle lst_ellipse lst_line lst_lwpolyline
       lst_pline lst_point lst_spline lst_xline ss sse ssl ssn)
  (setq lst "Line,Circle,Arc,Xline,Pline,Spline,LWpolyline,Ellipse,Insert")
  (setq ss (ssget "x" (list (cons 0 lst))))
  (setq ssl (sslength ss))
  (setq cnt 0)
  (repeat
    ssl
    (setq ssn (ssname ss cnt))
    (setq sse (entget ssn))
    (if
      (= (cdr (assoc 0 sse)) "LINE")
      (progn
(setq layl (cdr (assoc 8 sse)))
;(setq lst_line (append lst_line (list layl)))
(setq lst_line (cons layl lst_line))
(setq lst_line (RemoveDuplicateStrings lst_line))
(setq lst_line (remove lst_line))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "CIRCLE")
      (progn
(setq layc (cdr (assoc 8 sse)))
;(setq lst_circle (append lst_circle (list layc)))
(setq lst_circle (cons layc lst_circle))
(setq lst_circle (RemoveDuplicateStrings lst_circle))
(setq lst_circle (remove lst_circle))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "ARC")
      (progn
(setq laya (cdr (assoc 8 sse)))                ; "0"
;(setq lst_arc (append lst_arc (list laya)))
(setq lst_arc nil)
(setq lst_arc (cons laya lst_arc))
(setq lst_arc (RemoveDuplicateStrings lst_arc))
(setq lst_arc (remove lst_arc))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "XLINE")
      (progn
(setq layx (cdr (assoc 8 sse)))
;(setq lst_xline (append lst_xline (list layx)))
(setq lst_xline nil)
(setq lst_xline (cons layx lst_xline))
(setq lst_xline (RemoveDuplicateStrings lst_xline))
(setq lst_xline (remove lst_xline))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "PLINE")
      (progn
(setq layp (cdr (assoc 8 sse)))
;(setq lst_pline (append lst_pline (list layp)))
(setq lst_pline nil)
(setq lst_pline (cons layp lst_pline))
(setq lst_pline (RemoveDuplicateStrings lst_xline))
(setq lst_pline (remove lst_pline))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "SPLINE")
      (progn
(setq lays (cdr (assoc 8 sse)))
;(setq lst_spline (append lst_spline (list lays)))
(setq lst_spline nil)
(setq lst_spline (cons lays lst_spline))
(setq lst_spline (RemoveDuplicateStrings lst_spline))
(setq lst_spline (remove lst_spline))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "LWPOLYLINE")
      (progn
(setq laylw (cdr (assoc 8 sse)))
;(setq lst_lwpolyline (append lst_lwpolyline (list laylw)))
(setq lst_lwpolyline nil)
(setq lst_lwpolyline (cons laylw lst_lwpolyline))
(setq lst_lwpolyline (RemoveDuplicateStrings lst_lwpolyline))
(setq lst_lwpolyline (remove lst_lwpolyline))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "ELLIPSE")
      (progn
(setq laye (cdr (assoc 8 sse)))
;(setq lst_ellipse (append lst_ellipse (list laye)))
(setq lst_ellipse nil)
(setq lst_ellipse (cons laye lst_ellipse))
(setq lst_ellipse (RemoveDuplicateStrings lst_ellipse))
(setq lst_ellipse (remove lst_ellipse))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "POINT")
      (progn
(setq layp (cdr (assoc 8 sse)))
;(setq lst_point (append lst_point (list layp)))
(setq lst_point nil)
(setq lst_point (cons layp lst_point))
(setq lst_point (RemoveDuplicateStrings lst_point))
(setq lst_point (remove lst_point))
)                                             ; progn
      )                                               ; if
    (setq cnt (1+ cnt))
    )                                                 ; repeat
  (if (= lst_line nil)(setq lst_line "0"))
  (if (= lst_circle nil)(setq lst_circle "0"))
  (if (= lst_arc nil)(setq lst_arc "0"))
  (if (= lst_xline nil)(setq lst_xline "0"))
  (if (= lst_pline nil)(setq lst_pline "0"))
  (if (= lst_spline nil)(setq lst_spline "0"))
  (if (= lst_lwpolyline nil)(setq lst_lwpolyline "0"))
  (if (= lst_ellipse nil)(setq lst_ellipse "0"))
  (if (= lst_point nil)(setq lst_point "0")) 
  (alert (strcat "\nLOCATION NON XREF IN LAYER"
"\n"
"\nLINE object in layer  = " lst_line
"\n"
"\nCIRCLE object in layer  = " lst_circle
"\n"
"\nARC object in layer  = " lst_arc
"\n"
"\nXLINE object in layer  = " lst_xline
"\n"
"\nPLINE object in layer  = " lst_pline
"\n"
"\nSPLINE object in layer  = " lst_spline
"\n"
"\nLWPOLYLINE object in layer  = " lst_lwpolyline
"\n"
"\nELLIPSE object in layer  = " lst_ellipse
"\n"
"\nPOINT object in layer  = " lst_point))
  (princ)
  )
Logged

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: bad function: "0"
« Reply #1 on: January 10, 2007, 03:23:02 AM »
perhaps Try something like this :-

Code: [Select]
(DEFUN remove (str / [color=red]removex[/color] )
    (SETQ [color=red]removex[/color] (VL-STRING-TRIM "()" (VL-PRINC-TO-STRING str)))
   [color=red] removex[/color]
)
Logged
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: bad function: "0"
« Reply #2 on: January 10, 2007, 03:27:43 AM »
 ... or like this

Code: [Select]
(DEFUN remove (str )
     (VL-STRING-TRIM "()" (VL-PRINC-TO-STRING str))
)
Logged
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Adesu

  • Guest
Re: bad function: "0"
« Reply #3 on: January 10, 2007, 03:46:36 AM »
Hi Kerry,
that great,thanks
alert box would display,but why contain in layer still "0",look at attach file

Quote from: Kerry Brown on January 10, 2007, 03:27:43 AM
... or like this

Code: [Select]
(DEFUN remove (str )
     (VL-STRING-TRIM "()" (VL-PRINC-TO-STRING str))
)
Logged

Adesu

  • Guest
Re: bad function: "0"
« Reply #4 on: January 10, 2007, 03:53:24 AM »
Oops,sorry figure in attach file is right,I only have 0 layer,I hope you ignore it.
You had solve my code,many thanks.


Quote from: Adesu on January 10, 2007, 03:46:36 AM
Hi Kerry,
that great,thanks
alert box would display,but why contain in layer still "0",look at attach file

Quote from: Kerry Brown on January 10, 2007, 03:27:43 AM
... or like this

Code: [Select]
(DEFUN remove (str )
     (VL-STRING-TRIM "()" (VL-PRINC-TO-STRING str))
)
Logged

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: bad function: "0"
« Reply #5 on: January 10, 2007, 04:06:21 AM »
my pleasure ..
Logged
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Adesu

  • Guest
Re: bad function: "0"
« Reply #6 on: January 10, 2007, 04:12:47 AM »
Hi Kerry,
Here my code after your revised,and look at attach file
Code: [Select]
; cnxl is stand for Check Non Xref by Layer
;        Design by  : Adesu <Ade Suharna>
;        Email      : mteybid@yuasabattery.co.id
;        Homepage   : http://www.yuasa-battery.co.id
;        Create     : 08 January 2007
;        Program no.: 0508/01/2007
;        Edit by    : Adesu        10/01/2007   1).add remove
;                     Kerry Brown  10/01/2007   2).

(defun RemoveDuplicateStrings (stringlist / newlist) ; by kwb 20050221
  (foreach var stringlist
    (if
      (not (vl-position var newlist))
      (setq newlist (cons var newlist))
      )
    )
  (reverse newlist)
  )

(defun remove (str)                                   ; 2).
  (vl-string-trim "()" (vl-princ-to-string str))
  )


(defun c:cnxl (/ cnt laya layc laye layl laylw layp lays layx lst
       lst_arc lst_circle lst_ellipse lst_line lst_lwpolyline
       lst_pline lst_point lst_spline lst_xline ss sse ssl ssn)
  (setq lst "Line,Circle,Arc,Xline,Pline,Spline,LWpolyline,Ellipse,Insert")
  (setq ss (ssget "x" (list (cons 0 lst))))
  (setq ssl (sslength ss))
  (setq cnt 0)
  (repeat
    ssl
    (setq ssn (ssname ss cnt))
    (setq sse (entget ssn))
    (if
      (= (cdr (assoc 0 sse)) "LINE")
      (progn
(setq layl (cdr (assoc 8 sse)))
(setq lst_line nil)
(setq lst_line (cons layl lst_line))
(setq lst_line (RemoveDuplicateStrings lst_line))
(setq lst_line (remove lst_line))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "CIRCLE")
      (progn
(setq layc (cdr (assoc 8 sse)))
(setq lst_circle nil)
(setq lst_circle (cons layc lst_circle))
(setq lst_circle (RemoveDuplicateStrings lst_circle))
(setq lst_circle (remove lst_circle))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "ARC")
      (progn
(setq laya (cdr (assoc 8 sse)))               
(setq lst_arc nil)
(setq lst_arc (cons laya lst_arc))
(setq lst_arc (RemoveDuplicateStrings lst_arc))
(setq lst_arc (remove lst_arc))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "XLINE")
      (progn
(setq layx (cdr (assoc 8 sse)))
(setq lst_xline nil)
(setq lst_xline (cons layx lst_xline))
(setq lst_xline (RemoveDuplicateStrings lst_xline))
(setq lst_xline (remove lst_xline))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "PLINE")
      (progn
(setq layp (cdr (assoc 8 sse)))
(setq lst_pline nil)
(setq lst_pline (cons layp lst_pline))
(setq lst_pline (RemoveDuplicateStrings lst_xline))
(setq lst_pline (remove lst_pline))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "SPLINE")
      (progn
(setq lays (cdr (assoc 8 sse)))
(setq lst_spline nil)
(setq lst_spline (cons lays lst_spline))
(setq lst_spline (RemoveDuplicateStrings lst_spline))
(setq lst_spline (remove lst_spline))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "LWPOLYLINE")
      (progn
(setq laylw (cdr (assoc 8 sse)))
(setq lst_lwpolyline nil)
(setq lst_lwpolyline (cons laylw lst_lwpolyline))
(setq lst_lwpolyline (RemoveDuplicateStrings lst_lwpolyline))
(setq lst_lwpolyline (remove lst_lwpolyline))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "ELLIPSE")
      (progn
(setq laye (cdr (assoc 8 sse)))
(setq lst_ellipse nil)
(setq lst_ellipse (cons laye lst_ellipse))
(setq lst_ellipse (RemoveDuplicateStrings lst_ellipse))
(setq lst_ellipse (remove lst_ellipse))
)                                             ; progn
      )                                               ; if
    (if
      (= (cdr (assoc 0 sse)) "POINT")
      (progn
(setq layp (cdr (assoc 8 sse)))
(setq lst_point nil)
(setq lst_point (cons layp lst_point))
(setq lst_point (RemoveDuplicateStrings lst_point))
(setq lst_point (remove lst_point))
)                                             ; progn
      )                                               ; if
    (setq cnt (1+ cnt))
    )                                                 ; repeat
  (if (= lst_line nil)(setq lst_line "0"))
  (if (= lst_circle nil)(setq lst_circle "0"))
  (if (= lst_arc nil)(setq lst_arc "0"))
  (if (= lst_xline nil)(setq lst_xline "0"))
  (if (= lst_pline nil)(setq lst_pline "0"))
  (if (= lst_spline nil)(setq lst_spline "0"))
  (if (= lst_lwpolyline nil)(setq lst_lwpolyline "0"))
  (if (= lst_ellipse nil)(setq lst_ellipse "0"))
  (if (= lst_point nil)(setq lst_point "0")) 
  (alert (strcat "\nLOCATION NON XREF IN LAYER"
"\n"
"\nLINE object in layer  = " lst_line
"\n"
"\nCIRCLE object in layer  = " lst_circle
"\n"
"\nARC object in layer  = " lst_arc
"\n"
"\nXLINE object in layer  = " lst_xline
"\n"
"\nPLINE object in layer  = " lst_pline
"\n"
"\nSPLINE object in layer  = " lst_spline
"\n"
"\nLWPOLYLINE object in layer  = " lst_lwpolyline
"\n"
"\nELLIPSE object in layer  = " lst_ellipse
"\n"
"\nPOINT object in layer  = " lst_point))
  (princ)
  )

Quote from: Kerry Brown on January 10, 2007, 04:06:21 AM
my pleasure ..
Logged
Pages: [1] |   Go Up
« previous next »