I have the following 2D polylines in autocad.
I'm trying to create a code that when selecting all of them, it will filter out those who have a hatch inside.
From another source I've got the following piece of code (thanks tharwat), but, altough I understand every piece of it, from the second ssget I can't understand what those elements mean together.
(defun c:test (/ ss i sn e)
(if (setq ss (ssget '((0 . "POLYLINE")))) ;;selects all the polylines in a window
(repeat (setq i (sslength ss)) ;;cycles trough each one of them
(if (ssget "_CP" ;;???defines a crossing poligon inside wich the polylines will be considered???
(mapcar 'cdr ;;???
(vl-remove-if-not '(lambda (p) (= (car p) 10))
(entget (setq sn (ssname ss (setq i (1- i)))))
)
)
'((0 . "HATCH"))
)
(ssdel sn ss) ;;deletes the entities wich belong to the selection set
)
)
)
(sssetfirst nil ss)
(princ)
)
Beginner here, sorry if this is not a good question.
"_CP" effectively stands for Crossing Polygon.
This option requires a list of points (the polygon vertices).
(mapcar 'cdr ;;???
(vl-remove-if-not '(lambda (p) (= (car p) 10))
(entget (setq sn (ssname ss (setq i (1- i)))))
)
)
Builds this list of points from the polyline vertices.
So, this routine first prompt for the user to select polylines.
Then, iterates through the selection set and, for each selected polyline, tries to select any hatch by crossing polygon with the polyline vertices. If any the polyline is removed from the first selection set.
In my opinion, as is, this code isn't really safe for your goal due to the 'Crossing' option. Replacing "_CP" with "_WP" will use Window Polygon selection which is safer if polylines do not have arc segments.
Related
I'm creating some AutoLisp commands for my team, and now that I'm finished, the code breaks apart in their computer and I can't figure out why. Works fine in mine.
The idea of the code is to stretch a polyline and update the block attributes that is grouped with.
The code asks to select the block, the actual width of the polyline and the fraction that is is supposed to take (ex: 0.75 to reduce to 75%).
Then, and here is were the problem starts, select the sides to stretch. On their computers, he does not allow to select, it simply jumps ahead.
(defun c:MRV (/ a b c d e)
;ungroup
(command "pickstyle" 0)
;variables
(setq blk (entsel "\nSelect block to modify: "))
(initget (+ 1 2 4))
(setq a (getreal "\nWidth?"))
(initget (+ 1 2 4))
(setq b (getreal "\nNew module fraction? (>0;1<)"))
;distance to reduce
(setq c (- 1 b))
(setq d (* a c -0.5))
(setq e (* -1 d))
;stretch
(command "stretch" pause pause "" "0,0" (polar '(0 0) (/ pi 2) d))
(command "stretch" pause pause "" "0,0" (polar '(0 0) (/ pi 2) e))
;open layer
(setq LayerTable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(if (and (tblsearch "LAYER" "MC_BLOCO_INFO_AREAS")
(setq layname (vla-item layertable "MC_BLOCO_INFO_AREAS"))
(= (vlax-get-property layname 'lock) :vlax-true)
)
(vla-put-lock layname :vlax-false))
;change attribute
(setq l (cons "CAMPO_6" (rtos b 2 2)))
(LM:SetAttributeValues (car blk) (list l))
;close layer
(setq LayerTable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(if (and (tblsearch "LAYER" "MC_BLOCO_INFO_AREAS")
(setq layname (vla-item layertable "MC_BLOCO_INFO_AREAS"))
(= (vlax-get-property layname 'lock) :vlax-false)
)
(vla-put-lock layname :vlax-true))
;update block width
(command "regenall")
;regroup
(command "pickstyle" 1)
(print "Modulo modificado.")
(princ)
)
(defun LM:SetAttributeValues ( blk lst / enx itm )
(if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
(if (setq itm (assoc (strcase (cdr (assoc 2 enx))) lst))
(progn
(if (entmod (subst (cons 1 (cdr itm)) (assoc 1 enx) enx))
(entupd blk)
)
(LM:SetAttributeValues blk lst)
)
(LM:SetAttributeValues blk lst)
)
)
)
What should be happening:
When the AutoCAD STRETCH command issues the prompt for a selection of objects selected using a crossing window (crossing the segments that are to be stretched), the prompt is a standard selection prompt and the STRETCH command will subsequently obtain information about how the selection was acquired in the same way as you might using the AutoLISP ssnamex function.
As such, I would suggest supplying the STRETCH command with a selection set which has already been acquired using a crossing window selection method.
For example, you might define a function such as:
(defun mystretch ( dis / pt1 pt2 sel )
(while
(and
(setq pt1 (getpoint "\nSpecify first point of crossing window: "))
(setq pt2 (getcorner pt1 "\nSpecify opposite point of crossing window: "))
(not (setq sel (ssget "_C" pt1 pt2)))
)
(princ "\nNo objects were found within the crossing window.")
)
(if sel
(progn
(command "_.stretch" sel "" "_non" '(0 0) "_non" (list 0 dis))
t
)
)
)
You can then evaluate the above function with the distance that you wish to stretch the objects in the Y-direction, e.g.:
(mystretch 10.0)
Or, using the variables in your code:
(mystretch d)
(mystretch e)
The function will then return t (True) if the user has supplied two valid points and the STRETCH command has been issued - you can test for this in your program before proceeding.
Using this approach you can ensure that the user has supplied two points defining a crossing window which intersects one or more objects prior to issuing the AutoCAD STRETCH command.
The use of the ssget crossing mode string (C) also ensures that you are always supplying the STRETCH command which has been obtained using a crossing selection method.
You may also wish to refer to this answer regarding the use of the _non object snap modifier and also the _. command prefix in the above example code.
I am looking for some function that will allow me to automatically "rebuild" 1 or more splines in AutoCAD. I have drawings that have hundreds of splines with 30-50 control vertices each. This makes drawings very slow to work with, especially when interacting directly with a group of these splines.
I have the basic code for what I want to do, but am not sure at this point how to use the cvrebuild command in AutoLISP. Using that command in the command line simply brings up a GUI. See the code below for what I have so far.
I simply want to invoke the cvrebuild command using the variables n_controlvertices and degree as arguments. The AutoLISP routine would go through one object at a time and rebuild them with the same parameters.
I apologize for the appearance of the code. Apparently AutoLISP does not play well with StackOverflow
;; Batch rebuild splines
;;defines command name and variables
(defun c:batchrebuild (/ ss n obj n_controlvertices degree)
;; asks for selection
(prompt
"\nSelect splines to be rebuilt ."
)
;;decides if any splines are selected, and if not selects all
(if (not (setq ss (ssget '((0 . "SPLINE")))))
(setq ss (ssget "_X" '((0 . "SPLINE"))))
)
;;sets allowable entry to [2 (only nonzero) + 4 (only positive)]
(initget 6)
;;asks for number of fit points. if nothing is entered, it gives it the default value of 20
(setq n_controlvertices (getint "\nNumber of control vertices<20>: "))
(if
(= n_controlvertices nil)
(setq n_controlvertices 20)
(setq n_controlvertices (fix n_controlvertices))
)
;;asks for degree of fit points. if nothing is entered, it gives it the default value of 3
(setq degree (getint "\nDegree of fit points<3>: "))
(if
(= degree nil)
(setq degree 3)
(setq degree (fix degree))
)
(repeat (setq n (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
;;(command cvrebuild)
;;This is the part that I am not sure about
)
(princ)
)
Here's a way.
It calls the command line version of CVREBUILD (-CVREBUILD).
It deals with system variables for the user inputs settings.
;; Batch rebuild splines
;;defines command name and variables
(defun c:batchrebuild (/ ss n obj n_controlvertices degree rebuild2doption rebuild2ddegree rebuild2dcv cmdecho)
;; asks for selection
(prompt "\nSelect splines to be rebuilt.")
;;decides if any splines are selected, and if not selects all
(or (setq ss (ssget '((0 . "SPLINE"))))
(setq ss (ssget "_X" '((0 . "SPLINE"))))
)
;; checks if the selection is not empty
(if ss
(progn
;;sets allowable entry to [2 (only nonzero) + 4 (only positive)
(initget 6)
;;asks for number of fit points. if nothing is entered, it gives it the default value of 20
(setq n_controlvertices
(cond
((getint "\nNumber of control vertices<20>: "))
(T 20)
)
)
;;asks for degree of fit points. if nothing is entered, it gives it the default value of 3
(setq degree (cond
((getint "\nDegree of fit points<3>: "))
(T 3)
)
)
;; saves the sysvars current values
(setq rebuild2doption (getvar "REBUILD2DOPTION")
rebuild2ddegree (getvar "REBUILD2DDEGREE")
rebuild2dcv (getvar "REBUILD2DCV")
cmdecho (getvar "CMDECHO")
)
;; sets the sysvars values according to user inputs
(setvar "REBUILD2DOPTION" 1)
(setvar "REBUILD2DDEGREE" degree)
(setvar "REBUILD2DCV" n_controlvertices)
(setvar "CMDECHO" 0)
;; rebuilds the selected splines
(repeat (setq n (sslength ss))
(command "_-cvrebuild" (ssname ss (setq n (1- n))))
)
;; restores sysvars initial values
(setvar "REBUILD2DOPTION" rebuild2doption)
(setvar "REBUILD2DDEGREE" rebuild2ddegree)
(setvar "REBUILD2DCV" rebuild2dcv)
(setvar "CMDECHO" cmdecho)
)
)
(princ)
)
I have been stuck on this question for days. Apparently I need to write a better algorithm to win the algorithm below. The below code is implemented from the famous Aima file. Is there any expert here who could guide me on how to win the algorithm?
(defun find-closest (list)
(x (car (array-dimensions list)))
(y (cadr (array-dimensions list)))
(let ((elems (aref list x y)))
(dolist (e elems)
(when (eq (type-of e) type)
(return-from find-closest (list x y)))) nil))
I tried implementing a DFS but failed and I do not quite know why. Below is my code.
(defun find-closest (list)
(let ((open (list list))
(closed (list))
(steps 0)
(expanded 0)
(stored 0))
(loop while open do
(let ((x (pop open)))
(when (finished? x)
(return (format nil "Found ~a in ~a steps.
Expanded ~a nodes, stored a maximum of ~a nodes." x steps expanded stored)))
(incf steps)
(pushnew x closed :test #'equal)
(let ((successors (successors x)))
(incf expanded (length successors))
(setq successors
(delete-if (lambda (a)
(or (find a open :test #'equal)
(find a closed :test #'equal)))
successors))
(setq open (append open successors))
(setq stored (max stored (length open))))))))
Looking at the code, the function find-some-in-grid returns the first found thing of type. This will, essentially, give you O(n * m) time for an n * m world (imagine a world, where you have one dirt on each line, alternating between "left-most" and "right-most".
Since you can pull out a list of all dirt locations, you can build a shortest traversal, or at least a shorter-than-dump traversal, by instead of picking whatever dirt you happen to find first you pick the closest (for some distance metric, from the code it looks like you have Manhattan distances (that is, you can only move along the X xor the Y axis, not both at the same time). That should give you a robot that is at least as good as the dumb-traversal robot and frequently better, even if it's not optimal.
With the provision that I do NOT have the book and base implementation purely on what's in your question, something like this might work:
(defun find-closest-in-grid (radar type pos-x pos-y)
(labels ((distance (x y)
(+ (abs (- x pos-x))
(abs (- y pos-y)))))
(destructuring-bind (width height)
(array-dimensions radar)
(let ((best nil)
((best-distance (+ width height))))
(loop for x from 0 below width
do (loop for y from 0 below height
do (loop for element in (aref radar x y)
do (when (eql (type-of element) type)
(when (<= (distance x y) best-distance)
(setf best (list x y))
(setf best-distance (distance x y))))))))
best)))
I am working on a problem which requires finding all paths between two nodes in a directed graph. The graph may have cycles.
Notice that this particular implementation approach is an iterative DFS.
Several approaches I've considered are as follows -
BFS does not appear to have a way to neatly manage this kind of pathing relationships between nodes.
I don't see an easy mechanism for a DFS recursive algorithm to pass up the path when the terminating node is found. (Likely enough it could be done, if I implement a Maybe monad kind of thing).
Creating a GRAPH-PARENT routine. That would add a decent amount of churn (& bugs) in the existing code.
Abstractly, what needs to happen is a tree needs to be generated, with the start node as root, and all leafs are the terminating nodes. Each path from leaf to root is a legal path. That is what a recursive DFS would trace out.
I'm reasonably sure it can be done here, but I don't see exactly how to do it.
I've defined a protocol for this algorithm where GRAPH-EQUAL and GRAPH-NEXT can be defined for arbitrary objects.
The debug node type is a SEARCH-NODE, and it has the data accessor SEARCH-NODE-DATA.
(defun all-paths (start end)
(let ((stack (list start))
(mark-list (list start)) ;I've chosen to hold marking information local to all-paths, instead of marking the objects themselves.
(all-path-list '())) ; Not used yet, using debug statements to think about the problem
(do () ;; intializing no variables
;; While Stack still has elements
((not stack))
(let ((item (pop stack)))
;; I'm looking at the item.
(format t "I: ~a~%" (search-node-data item))
(cond ((graph-equal item end)
(format t "*Q: ~a~%" (loop for var in stack collect (search-node-data var)))
;;Unmark the terminal node so we can view it it next time.
(setf mark-list (remove item mark-list))))
(loop for next in (graph-next item)
do
(cond ((not (in next mark-list :test #'graph-equal))
;; mark the node
(push next mark-list)
;;Put it on the stack
(push next stack))))))))
See A Very General Method for Computing Shortest Paths for an algorithm that can return all paths in a graph (even when there are cycles) as regular expressions over the alphabet of edges in finite time (assuming a finite graph).
You need to pass the path list (mark-list) along with the nodes, since that is part of the state. I've renamed it path in this code:
(defun all-paths (start end)
(let ((stack (list '(start (start)))) ; list of (node path) elements
(all-path-list '()))
(do ()
((not stack))
(let ((item (pop stack)))
(let ((node (first item))
(path (second item)))
(format t "I: ~a~%" (search-node-data node))
(cond ((graph-equal node end)
(format t "*Q: ~a~%"
(loop for var in path
collect (search-node-data var)))))
(loop for next in (graph-next node)
do
(cond ((not (in next path :test #'graph-equal))
(push (list next (cons next path)) stack)))))))))
what is the problem this the next program in Scheme which solve the problem of Hanoy's tower
(define tower_of_hanoi
(lambda (move discs from to using)
(if (> discs 0)
((tower_of_hanoi move (- discs 1) from using to)
(tower_of_hanoi move (- discs 1) using to from)))))
(procedure application: expected procedure, given: #void; arguments were: #void)
Thank u all.
In your code you were calling two function calls in (). When you use that your symbol need to be a function/procedure. So you got the error.
Check the code below. I changed it to (and
(define tower_of_hanoi
(lambda (move discs from to using)
(if (> discs 0)
(and (tower_of_hanoi move (- discs 1) from using to)
(display move)(display " from ")(display from) (display " to ")(display to) (display "\n")
(tower_of_hanoi move (- discs 1) using to from)))))