Latest AutoLISP torture...

Anonymous · ‎01-12-2017

Why must AutoLISP torture me so?

I've attached a dwg that has two blocks....and the offending LISP routine that has one "who-knows-what" bug in it. I need the routine to change the all-white block to the colored block as shown. The one offending line is second-in from the left; it should be grey, but it will not change. All the other lines are cooperating beautifully.

I even tried hard-coding the line in position 1 to turn gray all on it's own without the "if-else" code in the LISP routine. No dice. Can someone help me correct this error so it will change to gray like the rest of the applicable lines? Thanks in advance!

Ranjit_Singh · ‎01-12-2017

The logic is quite convoluted. Try drawing a logic diagram and recode. I did not want to recode the whole thing, so did a quick fix. Replace this

(foreach x  vl
         (if (= 4 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR"))
         (if (= 5 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR"))
         (if (= 26 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR"))
	 (if (= 27 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR"))
	 (if (= 32 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR"))
         (if (= 33 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")))

with

(foreach x  vl
         (if (= 4 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
         (if (= 5 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
         (if (= 26 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
	 (if (= 27 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
	 (if (= 32 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
         (if (= 33 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS")))

Anonymous · ‎01-13-2017

Hi,

My snap settings are getting unchecked whenever I enter my WA(Wiring Arc) command. I cant snap onto anything once I enter this command. Is there a way to keep my snaps all checked regardless of whatever command I am typing?

Thank you.

Ranjit_Singh · ‎01-13-2017

Hi adminJ7PFV. I am not sure what writing arc is. If it's a LISP routine, then check the code to see what it's doing to your osnap settings. If the code is not restricted for sharing by it's owner then post the code and someone can check for you.

Also, I would recommend starting a new post. It keeps the topic relevant since this is not related to the OP.

Kent1Cooper · ‎01-13-2017

@Ranjit_Singh wrote:

....

Also, I would recommend starting a new post. It keeps the topic relevant since this is not related to the OP.

[Dealt with at the thread from which the WA routine came.]

Kent Cooper, AIA

Anonymous · ‎01-13-2017

Back to the ORIGINAL topic...

Ranjit.Singh...your solution is producing "error: malformed list on input"

I have been slaving away in the Visual LISP editor, matching up parentheses, and I cannot find the error.

Ranjit_Singh · ‎01-13-2017

;;*************************     {  APPLY BLOCK PROPERTIES  }      ****************************;;
;;                                                                                            ;;
;;       -------- Designed & Created by Satish Rajdev and Matthew Neesley ----------          ;;
;;                                                                                            ;;
;;       ------------------  Command to Invoke = "lg"      	          ----------          ;;
;;                                                                                            ;;
;;********************************************************************************************;;

(defun c:lg	(/	bks    cmd    nm     i	    bkl	   bk
		 angl	vl     a      b	     p	    ps	   fg
		 removedup     vert-p horiz-p	    addprop
		)

  ;;********************************************************************************************;;
  ;;****************************************  UTILITIES ****************************************;;
  ;;********************************************************************************************;;

  (defun *error* (msg)
    (if	(not
	  (wcmatch (strcase msg t) "*break,*cancel*,*exit*")
	)
      (progn
	(princ "")
	(setvar 'nomutt nm)
	(setvar 'cmdecho cmd)
	(vla-endundomark
	  (vla-get-activedocument (vlax-get-acad-object))
	)
      )
    )
    (princ)
  )
  (defun removedup (l)
    (if	l
      (cons (car l) (removedup (vl-remove (car l) (cdr l))))
      ;;removing duplicate element from the list
    )
  )
  (defun vert-p	(obj)
    (equal (car (vlax-get obj 'startpoint))
	   (car (vlax-get obj 'endpoint))
	   0.01
    )
    ;;comparing X axis with the fuzz factor 0.01
  )
  ;;function to verify whether line is vertical
  (defun horiz-p (obj)
    (equal (cadr (vlax-get obj 'startpoint))
	   (cadr (vlax-get obj 'endpoint))
	   0.01
    )
    ;;comparing Y axis with the fuzz factor 0.01
  )
  ;;function to verify whether line is horizontal
  (defun addprop (obj layer)
    (vla-put-color obj 256)
    ;;put color to bylayer
    (vla-put-layer obj layer)
    ;;put in the layer specifed
  )

  ;;********************************************************************************************;;
  ;;**************************************  MAIN PROGRAM ***************************************;;
  ;;********************************************************************************************;;

  (if (setq bks (ssget '((0 . "insert"))))
    ;;select block on screen
    (progn
      (vla-startundomark
	(vla-get-activedocument (vlax-get-acad-object))
      )
      ;;setting the undo mark
      (setq cmd	(getvar 'cmdecho)
	    nm	(getvar 'nomutt)
      )
      (setvar 'cmdecho 0)
      ;;hiding command window
      (setvar 'nomutt 1)
      ;;hiding other command details
      (mapcar '(lambda (x y)
		 (if (not (tblsearch "layer" x))
					;verifies layer are present or not
		   (entmakex (list
			       '(0 . "layer")
			       (cons 100 "AcDbSymbolTableRecord")
			       (cons 100 "AcDbLayerTableRecord")
			       (cons 2 x)
			       ;;add layername
			       (cons 70 0)
			       (cons 62 y)
			       ;;add color
			       (cons 6 "Continuous")
			     )
		   )
		 )
		 ;;creating layer
	       )
	      (list "HILMOT-ROLLERS"	    "HILMOT-SENSORS"
		    "HILMOT-FRAMES"	    "HILMOT-DRIVE CARDS"
		    "HILMOT-MDR"	    
		   )
	      ;;layer list
	      (list 8 1 4 5 3)
	      ;;color code for the layers
      )
      (repeat (setq i (sslength bks))
	;;setting the repeat count
	(setq bkl
	       (cons
		 (cdr (assoc 2 (entget (ssname bks (setq i (1- i))))))
		 bkl
	       )
	)
	;;getting the selected block list
      )
      (setq bkl (removedup bkl))
      ;;removing duplicate names of block
      (foreach bk bkl
	;;running code for every block
	(command "-bedit" bk)
	;;opening block editor
	(vla-zoomextents (vlax-get-acad-object))
	(setq angl nil
	      vl   nil
	)
	;;resetting the list here
	(if (setq a (ssget "_x" '((0 . "*line,*polyline"))))
	  ;;selecting all lines inside block in block editor
	  (progn
	    (repeat (setq i (sslength a))
	      (setq
		b (vlax-ename->vla-object (ssname a (setq i (1- i))))
	      )
	      ;;tracing all object
	      (cond
		((and (eq (vla-get-objectname b) "AcDbLine")
		      (vert-p b)
		      (> (vla-get-length b) 14.95)
		 )
		 (setq vl (cons	(list (cadr (vlax-get b 'startpoint))
				      (vla-get-length b)
				      b
				)
				vl
			  )
		 )
		;;if the object is VERTICAL line MORE THAN 14.95" IN LENGTH then make this vl list
	    (setq
	      vl (vl-sort
		   vl
		   (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))
		 )
	    )
	    ;; Sort vl (vertical lines) list from WEST to EAST with x axis
(cond ((= 40 (length vl))
       (foreach x  vl
         (if (= 4 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
         (if (= 5 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
         (if (= 26 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
	 (if (= 27 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
	 (if (= 32 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))
         (if (= 33 (vl-position x vl))
           (addprop (last x) "HILMOT-MDR")(addprop b "HILMOT-ROLLERS"))))
      (T (addprop b "HILMOT-ROLLERS")))
		 )
	    ((and (eq (vla-get-objectname b) "AcDbSpline")
			  (not (vlax-curve-isclosed b))
		     ) ;; if the object is SPLINE and it is NOT closed then do this
		     (addprop b "HILMOT-FRAMES")
		    )
	    ((and (eq (vla-get-objectname b) "AcDbPolyline")
			  (not (vlax-curve-isclosed b))
			  (< (vla-get-length b) 7.49)
		     ) ;; if the object is POLYLINE, not closed AND LESS THAN 7.49" IN LENGTH then do this
		     (addprop b "HILMOT-FRAMES")
		    )
	    ((and (eq (vla-get-objectname b) "AcDbPolyline")
			  (vlax-curve-isclosed b)
		     ) ;; if the object is POLYLINE and closed then do this
		     (addprop b "HILMOT-FRAMES")
		    )
            ((and (eq (vla-get-objectname b) "AcDbPolyline")
			  (not (vlax-curve-isclosed b))
			  (> (vla-get-length b) 7.49)
		     ) ;; if the object is POLYLINE, not closed AND GREATER THAN 7.49" IN LENGTH then do this
		     (addprop b "HILMOT-DRIVE CARDS")
		    )
            ((and (eq (vla-get-objectname b) "AcDbLine") 
		     (< (vla-get-length b) 2)
    		     )
		     (addprop b "HILMOT-FRAMES")
			) ;; if the object is LINE AND LESS THAN 2" IN LENGTH then do this
		(T ())
		)
	      )
	    )
	  ;progn
	  )
	;;if
	(vl-cmdf "_.bclose" "_sav")
	;;closing block editor
	(initcommandversion)
      )
      ;; foreach
      (setvar 'nomutt nm)
      (setvar 'cmdecho cmd)
      ;;restoring the variables again
      (vla-endundomark
	(vla-get-activedocument (vlax-get-acad-object))
      )
      ;;ending the undo mark
    )
  )
  (princ)
)

(vl-load-com)
(princ)
(princ
  (strcat
    "\n:: LiftGates.lsp ::"
    "\n:: Created by Satish Rajdev and Matthew Neesley | "
    (menucmd "M=$(edtime,$(getvar,date),DDDD\",\" D MONTH YYYY)"
    )
    " ::"
    "\n:: Type \"lg\" to Invoke ::"
  )
)
(princ)

Anonymous · ‎01-13-2017

YES YES YES YES!!!

I will compare your entire latest post with my previous catastrophe and try to locate the error as a learning tool. THANKS!

Community

Latest AutoLISP torture...

Latest AutoLISP torture...

Latest AutoLISP torture...