Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/23/2023 in all areas

  1. Try this expanding on what Steven suggested, if you can not see Arial the it does not exist, just copy the 3 lines to the command line. (vlax-for tsty (vla-get-TextStyles (vla-get-activedocument (vlax-get-acad-object))) (princ (strcat "\n" (vla-get-name tsty))) ) Standard RL S4 ISO2.5 ISO3.5 ISO5 notes ISO1.8 TITLEBLOCK ISOCP ROMAND ISO Arial ISO3098B Standard 2.5 Standard 5 Annotative Legend
    1 point
  2. Try putting this into the command line it should return somewhere in the list "Arial", if it is't in the list then the font isn't loaded into the drawing, you will need to go to font styles, select and load it (vla-get-TextStyles (vla-get-activedocument (vlax-get-acad-object))) (vla-get-TextStyles (vla-get-activedocument (vlax-get-acad-object))) (CAD is off for the night, but this should work, haven't checked though)
    1 point
  3. Having a quick look at this, it mostly works for me as your link test1, apart from the blocks - I haven't got time just now to work out why I changed the hatch slightly for the polylines, circles etc to be a bit quicker and added an undo marker - I'll see if I get chance to look at the blocks later (defun c:test1 ( / Lay_Old MySS target_layers block_names layer_name hatch_pattern ) (setq Lay_Old (getvar 'clayer)) ; Record the current layer ; Define a list of layers for hatching with different patterns (setq target_layers '( ("Layer1" "SOLID") ("Layer2" "SOLID") ("Layer3" "SOLID") ("Layer4" "SOLID") ("Layer5" "ANSI31") ("Layer6" "ANSI31") ("New Layer" "ANSI31") ("New Layer" "SOLID") ; Add more layers here as needed ) ; end list ) ; end setq ; Define a list of block names to hatch (setq block_names '("CIRCL" "Triangle" "MH3")) ;;Added undo mark (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark thisdrawing) (foreach layer_data target_layers (setq layer_name (car layer_data)) (setq hatch_pattern (cadr layer_data)) ; Set the current layer to "Chamber_Hatch" if the hatch pattern is "ANSI31" (if (equal hatch_pattern "ANSI31") (setvar 'clayer "Chamber_Hatch") ) ; Set the current layer to "Features_Hatch" if the hatch pattern is "SOLID" (if (equal hatch_pattern "SOLID") (setvar 'clayer "Features_Hatch") ) ; Select objects for hatching (setq MySS (ssget "X" (list '(0 . "*POLYLINE,CIRCLE,ARC,RECTANGLE") (cons 8 layer_name)))) (if MySS (progn ; (setq i 0) ; (repeat (sslength MySS) ; (setq ename (ssname MySS i)) (if (equal hatch_pattern "SOLID") ; (command "-hatch" "S" ename "" "P" "SOLID" "") ; (command "-hatch" "P" hatch_pattern 0.03 0.0 "S" ename "" "") ;;Changed to this, removes a loop and is quicker (command "-hatch" "S" MySS "" "P" "SOLID" "") (command "-hatch" "P" hatch_pattern 0.03 0.0 "S" MySS "" "") ) ; end if ; (setq i (1+ i)) ; ) ; end repeat ) ; end progn ) ; end if ; Select and hatch blocks (foreach block_name block_names (setq MySS (ssget "X" (list '(0 . "INSERT") (cons 8 layer_name) (cons 2 block_names)))) (if MySS (progn (setq i 0) (repeat (sslength MySS) (setq ename (ssname MySS i)) (if (equal hatch_pattern "SOLID") (command "-hatch" "S" ename "" "P" "SOLID" "") (command "-hatch" "P" hatch_pattern 0.03 0.0 "S" ename "" "") ) (setq i (1+ i)) ) ) ) ) ; Reset the current layer to the original layer (setvar 'clayer Lay_Old) ) ;;added this line (vla-endundomark thisdrawing) (princ) ; End quietly )
    1 point
  4. looks like you don't have the font Arial loaded but can't really diagnose anything with out seeing the lisps.
    1 point
  5. (defun c:foo ( / num_path i e c lst) (setq num_path (ssname (ssget (list (cons 0 "ARC"))) 0)) (setq e (ssname (ssget (list (cons 0 "TEXT"))) 0)) (setq c (trans (cdr (assoc 10 (entget e))) e 0)) (setq tmp_1 (vlax-curve-getClosestPointTo num_path c)) (setq tmp_2 (vlax-curve-getParamAtPoint num_path tmp_1)) (setq vec_pt (mapcar '- c tmp_1)) (setq vec_path (vlax-curve-getfirstderiv num_path tmp_2)) (if (minusp (sin (- (angle '(0 0 0) vec_pt) (angle '(0 0 0) vec_path)))) (alert "Outside Arc") (alert "Inside Arc") ) )
    1 point
  6. And this one works is out distance to the arc is greater or less than the distance to the origin of the arc. Noting taken the 'T' away from the vla- get closest line so only looks at the drawn arc (above looked at the circle that the arc was formed from). Works well with arcs up to 180 degree angle (semi-circle), afterwards not always (From Lee Macs suggestion) (defun c:inout ( / MyPoint ent1 vaobj1 dist1 ArcLen1 ent2 vlaobj2 dist2 ArcLen2 InnerDist OuterDist) (setq MyPoint (cdr (assoc 10 (entget (car (entsel "\nSelect Text")))))) ; Selected text insert point (setq ent1 (car (entsel "\nSelect Arc"))) ; Select arc (setq vlaobj1 (vlax-ename->vla-object ent1)) ; Selected arc as VLA-Object (setq dist1 (distance MyPoint (vlax-curve-getClosestPointTo vlaobj1 MyPoint)) ) (setq dist2 (distance (cdr (assoc 10 (entget ent1))) MyPoint )) (setq dist3 (cdr (assoc 40 (entget ent1))) ) ;;Dist 1: Txt to arc ;;Dist 2: Txt to origin ;;Dist 3: Radius (if (and (< Dist1 Dist2) (> Dist2 Dist3) ) ; Work out inside / outside (princ "\nOutside") (princ "\nInside") ) (princ) ; End quietly )
    1 point
  7. An alternative method, create a temporary arc line and work out which line the text is closest to.. and so whether the text is inside or outside. Note that 'outside' is if the text would be outside of a circle that the arc is taken from (so a long way inside 2x radius away becomes outside) No error checking on the selection of arc or text (From BigAls suggestion) (defun c:inout ( / MyPoint ent1 vaobj1 dist1 ArcLen1 ent2 vlaobj2 dist2 ArcLen2 InnerDist OuterDist) (setq MyPoint (cdr (assoc 10 (entget (car (entsel "\nSelect Text")))))) ; Selected text insert point (setq vlaobj1 (vlax-ename->vla-object (car (entsel "\nSelect Arc")))) ; Select arc as VLA-Object (setq dist1 (distance MyPoint (vlax-curve-getClosestPointTo vlaobj1 MyPoint T)) ) ;Distance text to arc (setq ArcLen1 (vlax-curve-getDistAtParam vlaobj1 (vlax-curve-getEndParam vlaobj1)) ) ; arc length (vla-Offset vlaobj1 (* ArcLen1 0.001)) ; Create temp line, offset small amount (setq ent2 (entlast)) ; new arc temporary line (setq vlaobj2 (vlax-ename->vla-object ent2)) ; get Arc as VLA-object (setq dist2 (distance MyPoint (vlax-curve-getClosestPointTo vlaobj2 MyPoint T)) ) ;Distance arc 2 to text (setq ArcLen2 (vlax-curve-getDistAtParam vlaobj2 (vlax-curve-getEndParam vlaobj2)) ) ; arc length (entdel ent2) ; delete temporary line ASAP (if (< ArcLen2 ArcLen1) ; Work out inner and outer arcs (setq InnerDist Dist1 OuterDist Dist2) (setq InnerDist Dist2 OuterDist Dist1) ) (if (< InnerDist OuterDist) ; Work out inside / outside (princ "\nOutside") (princ "\nInside") ) (princ) ; End quietly )
    1 point
  8. (defun c:demo (/ ans) (setq ans (LM:filtlistbox "Pick up a contents" '( "Content1" "Content2" "Almost heaven" "West Virginia" "Blue Ridge Mountains" "Shenandoah River" ) nil ) ) (command "_mleader" pause pause (car ans)) ) ; end_defun It's as simple as just changing the value between " and " to the value you want.
    1 point
  9. How can the distance from the arc center to 'Outside' be smaller than the radius?
    1 point
×
×
  • Create New...